Excel VBA.Net

Herkese merhaba,

Excel üzerinden bir listedeki adreslere dosya eklentisi yaparak mail atmak istiyorum. Web üserinden bulduğum kodları isteğime göre uyarladım. Her seferinde sabit bir mail adresi ile atıyor. Bu adresi değiştirmek için "SendUsingAccount" ile ilgili bulduğum kodu ekledim. OutAccount ilgili account 'u alıyor . Debug-Watch kısmında görüyorum ilgili account'u aldığnı ama yine de diğer mail adresi üzerinden atmaya devam ediyor . Desteğinizi rica ederim.

Kod: Tümünü seç

Sub ekli_eposta()

    Dim OutApp As Object
    Dim outMailItem As Object
    Dim OutAccount As Object
    Dim iCounter As Integer
    Dim sDest As String
    Dim sName As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutAccount = OutApp.Session.Accounts.Item(1)
            sDest = ""
    For I = 2 To WorksheetFunction.CountA(Columns(1))
        If I <> "" Then
        Set outMailItem = OutApp.CreateItem(0)
        With outMailItem
                sDest = Cells(I, 4).Value
                sName = Cells(I, 3).Value
                file = "C:\Users\ualpat\Documents\08122020\" & sName & ".pdf"
                .To = sDest
                .BCC = "bcc@vba.com"
                .Subject = "Konu bu"
                .htmlbody = "bla bla bla"
                .Attachments.Add file
                .SendUsingAccount = OutAccount
                .display
                '.send
                End With
            Else
            MsgBox ("Error")
            End If
    Application.Wait (Now + TimeValue("0:00:02"))
    Next
    Set outMailItem = Nothing
    Set OutApp = Nothing
    Set OutAccount = Nothing
End Sub

Merhaba,
.SentOnBehalfOfName = "XXxxXXxxXX"
şeklinde dener misiniz ?

Hocam merhaba,

Öneriniz için teşekkürler, önerinizi denediğimde adresi ilgili adres olarak seçiyor ancak bu adres Outlook'ta kurulu olmasına rağmen "Bu ileti gönderilemedi. Belirlenen kullanıcı adına ileti gönderme izniniz yok." hatası alıyorum. Gönderen ana mail adresim oluyor sadece görüntüde gönderen adres değişiyor gibi ve buna da müsaade etmiyor. Account numarasını doğru girmeme rağmen (aşağıdaki kod ile kontrol ediyorum) neden müsaade etmiyor anlamış değilim.

Kod: Tümünü seç

Sub Which_Account_Number()
    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim I As Long

    Set OutApp = CreateObject("Outlook.Application")

    For I = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
    Next I
End Sub