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