Originally Posted by
June7
Explore SentOnBehalfOfName property of email object.
I have modified following code to use SentOnBehalfOfName function but it didn't work... Please advise
Code:
Option Compare Database
Sub Command0_Click()
Dim sFileName As String, sEmail As String, BccEmail As String, eBody As String
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tbl_Email", dbOpenSnapshot) ' Table Name
eBody = "<HTML><BODY>Note</BODY></HTML>"
On Error Resume Next
rst.MoveFirst
Dim i As Integer
Dim x As Integer
For i = 1 To 500 'sending emails individually
sEmail = rst("Email_Address") 'Field Name
CCEmail = sEmail
BccEmail = ""
For x = 1 To 40 'Adding 40 email addreses to BCC
If Not rst.EOF Then
BccEmail = BccEmail & ";" & sEmail
rst.MoveNext
sEmail = rst("Email_Address")
End If
Next x
If BccEmail <> "" Then
Call vcSendEmail_Outlook_With_Attachment("Subject", "info@toemail.com", "", BccEmail, "\\fs2\Desktop\test.doc", eBody)
Call Wait_Time
End If
Next i
rst.Close
Set rst = Nothing
End Sub
----------------------------
----------------------------
Option Compare Database
Sub vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
OutMail.SentOnBehalfOfName = "email@From.com"
OutMail.To = sTo
If sCC <> "" Then OutMail.CC = sCC
If sBcc <> "" Then OutMail.BCC = sBcc
OutMail.Subject = sSubject
If sBody <> "" Then OutMail.HTMLBody = sBody
OutMail.Attachments.Add (sAttachment)
SendKeys "^{ENTER}"
OutMail.Send 'Send | Display
Set OutMail = Nothing
Set OutApp = Nothing
End Sub