kwarden13
asked on
From field OUTLOOK VBA
I need to send an email using vba on behalf of another mailbox. How can I tweak the code below to accomplish this?
Public Sub CreateAnEmail_Corp(filename As String, FullName As String, RecipentEmail As String, SupervisorEmail As String)
On Error Resume Next
Dim db As Database
Dim rs As Recordset
Dim ClientEmail As String
Dim DisplayMsg As Boolean
Dim AttachmentPath As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myarray() As String
Dim myaddresses() As String
Dim x As Integer
Dim fs As Object
Dim BuiltPath As String
Dim response As Integer
Dim WasOpen As Boolean
DisplayMsg = True
'AttachmentPath = "J:\data\" & ReportCaption & ".pdf"
If EnoughPrompts = 0 Then
MsgBox "The email is about to be created!" & vbCrLf & _
"If nothing appears to be happening, the Outlook security box may be hiding behind an open window." & vbCrLf & _
"Click the Outlook icon on the taskbar to bring it to the front, if necessary."
End If
EnoughPrompts = 1
Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
Err.Clear
WasOpen = False
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Else
WasOpen = True
End If
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers
If WasOpen = False Then
objOutlook.Explorers.Add Folder
Folder.Display
'done opening
End If
AppActivate "Microsoft Outlook"
' Create the message.
'Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'can't do this, the mail never gets sent
' Add the from recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add(somebody)
'objOutlookRecip.Type = olOriginator
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(RecipentEmail)
objOutlookRecip.Type = olto
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(SupervisorEmail)
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Kelly") objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "Notice of File"
.BodyFormat = olFormatHTML
.HTMLBody = "<p>" & FullName & "," & "</P>"
.HTMLBody = .HTMLBody & "The attached Notice to File is being placed in your Personnel File for failure to complete your required training by the due date. <br><br>"
.HTMLBody = .HTMLBody & "Please <a href = 'http://www.google.com'>CLICK HERE</a> to take your courses immediately. This training is mandatory and critical to ensure you are aware of important Company policies and procedures. <br><br>"
.HTMLBody = .HTMLBody & "In the future, failure to complete your Compliance training by the due date may lead to disciplinary action, up to and including termination. <br><br>"
.HTMLBody = .HTMLBody & "Thank you,<br><br>"
.HTMLBody = .HTMLBody & "Training Team"
' Add attachments to the message.
'reportcaption is passed in and split into myarray
'one attachment needs to be added for each element in myarray
AttachmentPath = "J:\data\" & filename
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
what did not work?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
My solution works best.
ASKER