I am using MS Access 2010 and new to VBA. I found the code below to forward an Outlook email with attachments. I receive the "method or data member not found" on the following line:
Set myToBeForwarded = Application.ActiveExplorer.Selection(1)
Specifically the .ActiveExplorer part.
Thanks for any help in advance.
Complete Code Below:
Code:
Sub ForwardEmail()
Dim myItem As Outlook.MailItem
Dim myToBeForwarded As Outlook.MailItem
Dim strRecipient As String
Dim strStatementMonth As String
Dim strThroughDate As String
Dim strHTML As String
Dim fs As Object
Dim Atmt As Attachment
Dim FileName As String
Dim Inbox As MAPIFolder
Dim MyItems As Items
Dim objOutlookAttach As Outlook.Attachment
Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set MyItems = Inbox.Items
Set myToBeForwarded = Application.ActiveExplorer.Selection(1)
Set fs = CreateObject("Scripting.FileSystemObject")
Set myItem = Application.CreateItemFromTemplate("C:\Users\username\AppData\Roaming\Microsoft\Templates\Statement.oft")
strHTML = myItem.HTMLBody
strLastName = InputBox("Recipients Last Name?")
strFirstName = InputBox("Recipients First Name?")
strPrefix = InputBox("Recipients Prefix (ex. Mr., Ms., Dr.)?")
strMatterID = InputBox("Matter Number?")
strStatementMonth = InputBox("What is the statement date?")
strThroughDate = InputBox("Services rendered through what date?")
myItem.HTMLBody = Replace(myItem.HTMLBody, "%STATEMENTMONTH%", strStatementMonth)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%THROUGHDATE%", strThroughDate)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%RECIPIENT%", strRecipient)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%PREFIX%", strPrefix)
myItem.HTMLBody = Replace(myItem.HTMLBody, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%LASTNAME%", strLastName)
myItem.Subject = Replace(myItem.Subject, "%FIRSTNAME%", strFirstName)
myItem.Subject = Replace(myItem.Subject, "%MATTERID%", strMatterID)
For Each Atmt In myToBeForwarded.Attachments
'save it in C:\temp
FileName = "C:\TempPDF\" & Atmt.FileName
Atmt.SaveAsFile FileName
'now attach it to the new message
Set objOutlookAttach = myItem.Attachments.Add(FileName)
fs.deletefile FileName, True
Next
myItem.Display
End Sub