RECURSİVE OUTLOOK MAİL OKUMA PROJESİ - CANLI KODLAMA (KODLAR AÇIKLAMADA)

Sıfırdan proje tasarimi ve kodlamasi canli ders
Kurumsal eğitimler ve danışmanlık için 0532 456 53 99 numarasından ulaşabilirsiniz.
Option Explicit
Public Sub LoopOutlook()
Dim olApp As Object
Dim olNS As Object
Dim olParentFolder As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo errPlace
Set olNS = olApp.GetNameSpace("MAPI")
Set olParentFolder = olNS.GetDefaultFolder(6).Folders("Adaylar")
ProcessFolder olParentFolder
errPlace:
Set olParentFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
Private Sub ProcessFolder(ByVal oParent As Object)
Dim olFolder As Object
Dim olMail As Object
Dim i As Long
Dim phoneNumber As String
For i = oParent.items.Count To 1 Step -1
If TypeName(oParent.items(i)) = "MailItem" Then
Set olMail = oParent.items(i)
If olMail.UnRead And _
Application.WeekNum(olMail.receivedTime) = Application.WeekNum(Date) And _
Year(olMail.receivedTime) = Year(Date) Then
phoneNumber = ""
phoneNumber = GetPhoneNumber(Trim(olMail.Body))
If Not phoneNumber ="" Then
Rem SendSMSAPI phoneNumber
End If
End If
End If
Next i
If Not oParent.Folders.Count = 0 Then
For Each olFolder In oParent.Folders
ProcessFolder olFolder
Next
End If
End Sub
Private Function GetPhoneNumber(ByVal tmpStr As String) As String
Dim i As Long
If tmpStr = "" Then Exit Function
tmpStr = Replace(tmpStr, "(", "")
tmpStr = Replace(tmpStr, ")", "")
tmpStr = Replace(tmpStr, "-", "")
tmpStr = Replace(tmpStr, "_", "")
tmpStr = Replace(tmpStr, " ", "")
tmpStr = Trim(tmpStr)
On Error Resume Next
For i = 1 To Len(tmpStr)
If Mid(tmpStr, i, 1) = "05" Then
If IsNumeric(Mid(tmpStr, i, 10)) Then
GetPhoneNumber = Mid(tmpStr, i, 10)
Exit Function
End If
End If
Next i
On Error GoTo 0
End Function

[@adnankarabacak5878]

Konusur gibi yine Kod yazdiniz Hocam.Harika. Yazilim Mantigini adim adim Sizlerin Sayenizde ögreniyoruz. Ellerin Dert görmesin.

[@UzmanExcel]

Cok teşekkür ederim Adnan Bey. Eksik olmayın

[@sedataksakal414]

VBA'yı garip bırakmayalım. VBA candır :)
Canlı yaptığınız kodlama çok faydalı oluyor. Gerçek proje uygulamalarında bir çok konuyu aynı anda işlemiş oluyorsunuz ve kodlamaya profesyonel olarak bakmayı görmüş oluyoruz.
Emek veriyorsunuz, teşekkür ediyorum. İyi çalışmalar

[@UzmanExcel]

Ben teşekkür ederim Sedat Bey. Çok sağolun

[@aydncataldere3994]

Gayet güzel profesyonel bir kod oldu. Sizi seyrettikçe kodlama mantığım gelişiyor. Emeğinize sağlık hocam. Videolarınızın devamını bekleriz. İyi Akşamlar. 🎉

[@UzmanExcel]

Cok teşekkür ederim Aydin Bey. Size de hayirli akşamlar. Vaktim oldukca cekecegim videoları

[@velatonen1119]

Bu harika anlatımlara bu kadar az beğeni gelmesi şaşırtıcı. Harika işler yapıyorsunuz. SMS api ile bu devamı niteliğinde bir çalışma bekliyoruz. Teşekkürler.

[@UzmanExcel]

Çok teşekkür ederim. Cok naziksiniz. Ornek bir sms api servisi varsa sizden fikir alabilirim

[@Bilgemen]

Yine Süper bir video elinizde sağlık

[@UzmanExcel]

Cok teşekkür ederim. Cok naziksiniz

[@SamirEliyev-i2w]

Merhaba Hocam nasilsiniz? Video için teşekkür ederim. Bizim için çok güzel bir ders oldu. Sayenizde VBA'yı öğrendik. Bir sonraki videoda bize API öğretirseniz çok mutlu olurum. Bu konuyla ilgili video internetde bulamadım.Lütfen bu konuda bana yardım edin

[@UzmanExcel]

Cok teşekkür ederim. İnsallah tabiki

[@zaferesen]

Mehmet hocam elinize sağlık.
Mehmet hocam listbox ta direk son sütuna odaklanacağımız yani kaydırma çubuğunu en sağa çekebileceğimiz bir kod çözümü var mıdır? Ben bulamadım. Teşekkürler

[@UzmanExcel]

Teşekkür ederim Zafer Bey. Tam bilmiyorum ama çoklu sütundan en sondaki degeri secsek olur mu? Ya da sendkeys ile de olabilir

[@leventkuruc-j6z]

kodu da koysaydınız keşke

[@UzmanExcel]

Koyacaktim. Unutmusum