VBA otomatik mail gönderme

[nzmsmz]

Merhaba VBA uzmanları,

Sizler için basit benim için zor olan bir konuda takıldım yardımlarınızı bekliyorum.

EKTE ÖRnek dosya paylaştım, bir kısmını yaptım ama yine de istediğim sonucu alamadım,
listede gelen e spostalara Outlook 2010 dan otomatik mail göndereceğim ama aşağıdaki şekilde uyarlanması lazım.

GİTMESİ GEREKEN metin; Merhaba "B sütundaki isim" adınıza kayıtlı olan "a sutundaki takip no" numaralı talebi yonlendirmeniz gerekmektedir. C sutundaki e posta adresinleri gidecek, ayrıca gidecek olan mailin konu kısmında da "a sutundaki takip no" talebiniz ile ilgili şeklinde gitmesi lazım.

Yaşadığım asıl sıkıntı şu; e postaları ikinci sayfadan düşey ara ile çekmek zorundayım. ama düşey ara ile çekince e posta adresini tanımıyor gibi mail göndermiyor. normal metin yapıstırınca gonderiyor. Ne yapmam lazım. Dosyayı yazabilecek usta varmı


https://drive.google.com/file/d/0B9IeOwtua-QoZXl1bGg3Ym4tb1k/view?usp=sharing

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        
        Dim xlOutlook   As Object
        Dim xlMail      As Object
        Set xlOutlook = CreateObject("Outlook.Application")
        Set xlMail = xlOutlook.CreateItem(0)
        
        With xlMail
            .To = Cells(i, "C").Value
            .CC = ""
            .Subject = Cells(i, "A").Value & " talebiniz ile ilgili"
            .Body = "Merhaba " & Cells(i, "B").Value & Chr(10) & _
            Cells(i, "A").Value & " numaralı talebi yönlendirmeniz gerekmektedir."
            .Save
            '.Display
            .Send
        End With
        
    Next i
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

. . .

 

[nzmsmz]

Hocam çok teşekkür ederim sorunu çözmüşsün tamda istediğim gibi oldu. Birşey soracağım VB kodu ile gönderdiğimde imzamı seçmiyor neden olabilir.

 

[Emir Hüseyin Çoban]

Imzaniz bilgisayarda .html olarak kayitlidir.
Dosya yolunu verirseniz maile ekleyebiliriz.

. . .

 

[nzmsmz]

Kopyayı verdiniz o yetti çok teşekkürler

 

[nzmsmz]

Emir bey merhaba, beceremedim ve tekrar geldim imza yolu "C:\Users\Nzmsmz\AppData\Roaming\Microsoft\Signatures\3htm" imzayı makroya ekleyebilirmiyiz, ben bu şekilde düzenledim kodu kendime göre;

Birde 2. bir isteğim var eğer olabiliyorsa tabi, düzenlediğim bu makroya, her bir maili 2 dakika aralıklarla göndermesi mümkünmü, yani 1. satırı gonderdikten sonra 2. satırı 2 dakika sonra 3. satırı 2 dakika sonra gibi

Sub KOD()
    
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For i = 2 To Cells(Rows.Count, "C").End(3).Row
        
        Dim xlOutlook   As Object
        Dim xlMail      As Object
        Set xlOutlook = CreateObject("Outlook.Application")
        Set xlMail = xlOutlook.CreateItem(0)
        
        With xlMail
            .To = Cells(i, "T").Value
            .CC = Cells(i, "V").Value
            .Subject = Cells(i, "C").Value & " metin"
            .Body = "isim " & Cells(i, "W").Value & Chr(10) & _
            Cells(i, "C").Value & " ametin"
            .Save
            '.Display
            .Send
        End With
        
    Next i
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    For i = 2 To Cells(Rows.Count, "C").End(3).Row
        
        Dim xlOutlook   As Object
        Dim xlMail      As Object
        Set xlOutlook = CreateObject("Outlook.Application")
        Set xlMail = xlOutlook.CreateItem(0)
        
        With xlMail
            .To = Cells(i, "T").Value
            .CC = Cells(i, "V").Value
            .Subject = Cells(i, "C").Value & " metin"
            Set FSO = CreateObject("Scripting.FileSystemObject")
            imzayolu = "C:\Users\Nzmsmz\AppData\Roaming\Microsoft\Signatu res\3.htm"
            Set imza = FSO.OpenTextFile(imzayolu, 1)
            .HTMLBody = "isim " & Cells(i, "W").Value & "<BR>" & _
            Cells(i, "C").Value & " ametin" & "<BR>" & imza.readall
           [COLOR="Green"] '.Body = "isim " & Cells(i, "W").Value & Chr(10) & _
            Cells(i, "C").Value & " ametin"[/COLOR]            
            .Save
            .Display
            .Send
        End With
        Application.Wait (Now() + TimeValue("00:02:00"))
        
    Next i
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

. . .