Sayfanın bir örneğini mail atan makro niçin iki kere ata

[bezl]

aşağıdaki kodla sayfanın bir örneğini 4 mail adresine mail attırıyorum. Daha öncelelir düzgün çalışıyordu ama artık çalıştırdığımda her maile 2'şer adet atıyor sebebi ne olabilir.

Sub Mail_Workbook_2()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wbname As String
    Application.ScreenUpdating = False
    Sheets(1).Range("A1").Select
    Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Password = ""
    
    Set wb1 = ActiveWorkbook
    wbname = "C:/" & _
    Format(Now, "dd.mm.yyyy") & ".xls"
    wb1.SaveCopyAs wbname
    
    Set wb2 = Workbooks.Open(wbname)
    With wb2
        .SendMail "a@a.com.tr", Format(Now, "dd.mm.yyyy")
        .SendMail "b@b.com.tr", Format(Now, "dd.mm.yyyy")
        .SendMail "c@c.com.tr", Format(Now, "dd.mm.yyyy")
        .SendMail "d@d..com.tr", Format(Now, "dd.mm.yyyy")
        .ChangeFileAccess xlReadOnly
         Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
    Sheets("GENEL").Range("A1").Value = "=today()"
    ActiveWorkbook.Password = "a"
End Sub

 

[bezl]

Bu konuda yardımcı olabilecek var mı? Aslında aynı makroyu daha öncekullandığımda böyle bir sorun yoktu ama şimdi kullandığımda hesaplara ikişer adet mail atıyor neden olabilir acaba?

 

[htsumer]

Bunu deneyin

http://www.rondebruin.nl/mail/folder1/mail2.htm

Sub Mail_test()
    Dim wb As Workbook
    Dim strdate As String
    Dim Shname As Variant
    Dim Addr As Variant
    Dim N As Integer

    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    Shname = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
    Addr = Array("ron@test.nl", "jelle@test.nl", "judith@test.nl", "nicolet@test.nl")

    Application.ScreenUpdating = False

    For N = LBound(Shname) To UBound(Shname)
        Sheets(Shname(N)).Copy
        Set wb = ActiveWorkbook
        With wb
            .SaveAs "Sheet " & Shname(N) _
                  & " " & strdate & ".xls"
            .SendMail Addr(N), _
                      "This is the Subject line"
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .Close False
        End With
    Next N
    Application.ScreenUpdating = True
End Sub

 

[bezl]

Benim yazdığım Outlook Express için di bu yazdığınız da outlook express te geçerli mi?

 

[Haluk]

Her iki kod da Excel'in SendMail fonksiyonunu kullanıyor.

Yani, bilgisayardaki varsayılan E-Mail programı ile mailler gönderiliyor. İster MS Outlook olsun, isterse Outlook Express kullanılsın, fark etmez her ikisi ile de çalışır.

 

[bezl]

Çok teşekkürler çok işime yaradı.