Email Gönderirken Yavaş Çalışıyor

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Aşağıdaki kodlarla önce pdf oluşturup pdf dosyasını ekleyerek e-posta gönderiyorum. Listemde gönderilecek posta sayısı 400 den fazla. Ve her birine ayrı dosya eki atacağım için tek tek göndermek zorundayım.
Kodlar mail gönderme kısmında takılır gibi oluyor 3-4 saniye duraksıyor.
Doğru olmayan bir şey mi yapıyorum?
Daha hızlı çalışması için ne yapmalıyım?

Not : http://www.mapilab.com/outlook/secur...reenshots.html bağlantısındaki uygulamayaı yüklerek outlook uyarısından kurtuldum. Bunun etkisi var mı bilemiyorum
C++:
Sub Yeni_Mail_Gonder()
Dim i As Long
Dim Sh As Worksheet
Dim Otopark As Variant
Dim fdObj As Object
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim WbName As String

    Set fdObj = CreateObject("Scripting.FileSystemObject")
    Set Sh = Worksheets("Yaz")
    For i = 2 To 3 'Cells(Rows.Count, "A").End(3).Row
        Sh.Range("D19") = Range("A" & i)
        Sh.Range("D20") = Range("B" & i) & " Blok"
        Sh.Range("D21") = Right(Range("C" & i), Len(Range("C" & i)) - 1)
        Sh.Range("D22") = "Adres1"
        Sh.Range("D23") = Range("D" & i)
        Sh.Range("D24") = Range("E" & i)
        Sh.Range("D25") = Range("F" & i)
        Sh.Range("D26") = Range("G" & i)
        Sh.Range("D27") = Range("H" & i)
        Sh.Range("D28") = 55
        Sh.Range("D29") = Range("J" & i)
        With Worksheets("Yaz")
            .ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "/" & Range("H" & i), _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End With
        If Len(Range("F" & i)) > 0 And InStr(1, Range("F" & i), "@") > 0 Then
            Set OutApp = New Outlook.Application
            Set NewMail = CreateItem(olMailItem)
            With NewMail
                .To = Range("F" & i).Value
                .Subject = "Toplu Yapı Site Geçici Yönetimi Bilgilendirme"
                .Body = "Sayın " & Range("D" & i).Value & "," & Chr(10) & "Toplu Yapı Site Geçici Yönetim tarafında hazırlanan bilgilendirme yazısı ve daire bilgi kartı ektedir."
                .Attachments.Add ThisWorkbook.Path & "/" & Range("H" & i) & ".pdf"
                .Save
                .Send
            End With
            Set NewMail = Nothing
            Set OutApp = Nothing
            Set VBComp = Nothing
            Kill ThisWorkbook.Path & "/" & Range("H" & i) & ".pdf"
        End If
    Next i
    i = Empty
    MsgBox "E-Mailleriniz gönderilmiştir.", vbInformation, Application.UserName
End Sub
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Konu halen günceldir.
 
Katılım
18 Ocak 2019
Mesajlar
234
Excel Vers. ve Dili
Office 2013
Merhaba @NextLevel

Yanlış anlamadıysam bu şekilde deneyebilir misiniz.

Kodda yer alan aşağıdaki satırı For i=2 To ....
satırının hemen altına alıp deneyin.

PHP:
If Len(Range("F" & i)) > 0 And InStr(1, Range("F" & i), "@") > 0 Then.
 
Katılım
24 Nisan 2005
Mesajlar
3,669
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Aşağıdaki kodlarla önce pdf oluşturup pdf dosyasını ekleyerek e-posta gönderiyorum. Listemde gönderilecek posta sayısı 400 den fazla. Ve her birine ayrı dosya eki atacağım için tek tek göndermek zorundayım.
Kodlar mail gönderme kısmında takılır gibi oluyor 3-4 saniye duraksıyor.
Doğru olmayan bir şey mi yapıyorum?
Daha hızlı çalışması için ne yapmalıyım?

Not : http://www.mapilab.com/outlook/secur...reenshots.html bağlantısındaki uygulamayaı yüklerek outlook uyarısından kurtuldum. Bunun etkisi var mı bilemiyorum
C++:
Sub Yeni_Mail_Gonder()
Dim i As Long
Dim Sh As Worksheet
Dim Otopark As Variant
Dim fdObj As Object
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim WbName As String

    Set fdObj = CreateObject("Scripting.FileSystemObject")
    Set Sh = Worksheets("Yaz")
    For i = 2 To 3 'Cells(Rows.Count, "A").End(3).Row
        Sh.Range("D19") = Range("A" & i)
        Sh.Range("D20") = Range("B" & i) & " Blok"
        Sh.Range("D21") = Right(Range("C" & i), Len(Range("C" & i)) - 1)
        Sh.Range("D22") = "Adres1"
        Sh.Range("D23") = Range("D" & i)
        Sh.Range("D24") = Range("E" & i)
        Sh.Range("D25") = Range("F" & i)
        Sh.Range("D26") = Range("G" & i)
        Sh.Range("D27") = Range("H" & i)
        Sh.Range("D28") = 55
        Sh.Range("D29") = Range("J" & i)
        With Worksheets("Yaz")
            .ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "/" & Range("H" & i), _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End With
        If Len(Range("F" & i)) > 0 And InStr(1, Range("F" & i), "@") > 0 Then
            Set OutApp = New Outlook.Application
            Set NewMail = CreateItem(olMailItem)
            With NewMail
                .To = Range("F" & i).Value
                .Subject = "Toplu Yapı Site Geçici Yönetimi Bilgilendirme"
                .Body = "Sayın " & Range("D" & i).Value & "," & Chr(10) & "Toplu Yapı Site Geçici Yönetim tarafında hazırlanan bilgilendirme yazısı ve daire bilgi kartı ektedir."
                .Attachments.Add ThisWorkbook.Path & "/" & Range("H" & i) & ".pdf"
                .Save
                .Send
            End With
            Set NewMail = Nothing
            Set OutApp = Nothing
            Set VBComp = Nothing
            Kill ThisWorkbook.Path & "/" & Range("H" & i) & ".pdf"
        End If
    Next i
    i = Empty
    MsgBox "E-Mailleriniz gönderilmiştir.", vbInformation, Application.UserName
End Sub
Outlook uyarısı izin ver ise bunun çözümü
için güncel antivirüs bulunması yeterli, ücretsiz olanlardan da olur.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Merhaba @NextLevel

Yanlış anlamadıysam bu şekilde deneyebilir misiniz.

Kodda yer alan aşağıdaki satırı For i=2 To ....
satırının hemen altına alıp deneyin.

PHP:
If Len(Range("F" & i)) > 0 And InStr(1, Range("F" & i), "@") > 0 Then.
Teşekkürler, ancak excel sayfasını her bir satır için düzenledikten sonra ilgili satırda email adresi olmasa dahi print edildiği, email adresi mevcutsa hem print edildiği hem de posta gönderimi yapıldığı için böyle olmak zorunda.
 
Üst