Otomatik Mailde From (İkincil Mail Adresi) Hatası

[baysevimli]

Değerli Arkadaşlar Merhaba,

Aşağıda otomatik mail atan bir makro kodum var. Yalnız bu kod benim outlook adresimden mail atıyor. Benim şirket grup maillerim var iki tane Ben istiyorum ki sayfa1 de M2 hücresinde yazan e posta adresinden atsın.
Nasıl yapabiliriz ?

Option Explicit

Sub Mail_Gonder()
    Dim OutApp As Object, OutMail As Object
    Dim Alan As Range, Son As Long, Veri As Range

    Application.ScreenUpdating = False

    On Error Resume Next
    With Sheets("Sayfa1")
        .Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("J1"), Unique:=True
         Son = .Cells(Rows.Count, "J").End(3).Row
         For Each Veri In .Range("J2:J" & Son)
             Son = .Cells(Rows.Count, "A").End(3).Row
            .Range("A1:G" & Son).AutoFilter 3, Veri
             Son = .Cells(Rows.Count, "A").End(3).Row
             Set Alan = .Range("A1:G" & Son).SpecialCells(xlCellTypeVisible)
             Set OutApp = CreateObject("Outlook.Application")
             Set OutMail = OutApp.CreateItem(0)
             With OutMail
                .Display
                .To = Veri.Offset(0, 1).Value
                .Cc = ""
                .Bcc = Veri.Offset(0, 2).Value
                .Subject = "Birim Kart Hareketi Raporu"
                .Htmlbody = "<br>Sn. Yönetici,<br>" & _
                            "<br>Biriminize ait personellerin kart hareketleri aşağıdaki tabloda mevcuttur.<br>" & _
                            "<br>Bilgilerinize arz ederiz.<br>" & RangetoHTML(Alan) & .Htmlbody
                .SendUsingAccount = OutApp.Session.Accounts.Item(Range("M2").Value)
                '.Send
             End With
         Next
        .ShowAllData
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing

    Application.ScreenUpdating = True
End Sub

 

[turist]

.SendUsingAccount = OutApp.Session.Accounts.Item(Range("M2").Value)

satırı yerine aşağıdaki kodu yazrak deneyin.

  If Range("M2") = "Birinci email adresiniz" Then
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
Else
                 .SendUsingAccount = OutApp.Session.Accounts.Item(2)
End If

 

[baysevimli]

Sn. Turist,
Test ettim ancak hiç bir aksiyon alamadım. Kodu yapıştırdığımda makrom çalışmadı.