Adding an attachment to a forwarded email VBA Script

[mjcharry]

Hi,

I am currently using a VBA script i found that forwards any email into HTML format. I want to add code that will make the script also add a multiple pdf's as attachments.

Any assistance would be greatly appreciated. I am a newb at VBA scripts.

Regards,
Michael

[gmayor]

What code did you find?
Do you want ALL messages you receive to be forwarded or just some, in which case, which?
What are the PDFs you want to attach?

The following should get you started


Sub SendOnMessage(olItem As MailItem)Dim olOutMail As Outlook.MailItem
Const strAtt1 As String = "C:\Path\Doc1.pdf"
Const strAtt2 As String = "C:\Path\Doc2.pdf"
Const strAtt3 As String = "C:\Path\Doc3.pdf"
Const strTo As String = "someone@somewhere.com"
If TypeName(olItem) = "MailItem" Then
Set olOutMail = olItem.Forward
With olOutMail
.To = strTo
.Subject = olItem.Subject
.Attachments.Add strAtt1
.Attachments.Add strAtt2
.Attachments.Add strAtt3
.HTMLBody = olItem.HTMLBody
.Display 'Change to .Send after testing
End With
End If
lbl_Exit:
Set olOutMail = Nothing
Exit Sub
End Sub


Sub Test()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
SendOnMessage olMsg
lbl_Exit:
Exit Sub
End Sub

[mjcharry]

Hi,

This is the code I am using. How would I modify this code to be able to add specific PDF attachments.



Sub ForceForwardInHTML()



Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application

'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.Count > 0 Then
Set objItem = objSelection.Item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "Forward in HTML")
Exit Sub
End If

Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem

Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
" or open an item first.", _
vbCritical, "Forward in HTML")
Exit Sub
End Select


Dim olMsg As Outlook.MailItem
Dim olMsgForward As Outlook.MailItem
Dim IsPlainText As Boolean

'Change the message format and reply
If objItem.Class = olMail Then
Set olMsg = objItem
If olMsg.BodyFormat = olFormatPlain Then
IsPlainText = True
End If
olMsg.BodyFormat = olFormatHTML
Set olMsgForward = olMsg.Forward
If IsPlainText = True Then
olMsg.BodyFormat = olFormatPlain
End If
olMsg.Close (olSave)
olMsgForward.Display

'Selected item isn't a mail item
Else
Result = MsgBox("No message item selected. " & _
"Please make a selection first.", _
vbCritical, "Forward in HTML")
Exit Sub
End If

'Cleanup
Set objOL = Nothing
Set objItem = Nothing
Set objSelection = Nothing
Set olMsg = Nothing
Set olMsgForward = Nothing

End Sub

[gmayor]

Your code is essentially the same so you can add attachments (3 in the example) in the same way e.g.


Sub ForceForwardInHTML()

Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Dim olMsg As Outlook.MailItem
Dim olMsgForward As Outlook.MailItem
Dim IsPlainText As Boolean
Dim Result As Long
'define three attachnments
Const strAtt1 As String = "C:\Path\Doc1.pdf"
Const strAtt2 As String = "C:\Path\Doc2.pdf"
Const strAtt3 As String = "C:\Path\Doc3.pdf"


Set objOL = Outlook.Application


'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.Count > 0 Then
Set objItem = objSelection.Item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "Forward in HTML")
GoTo Cleanup
End If


Case "Inspector"
Set objItem = objOL.ActiveInspector.currentItem


Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
" or open an item first.", _
vbCritical, "Forward in HTML")
GoTo Cleanup
End Select






'Change the message format and reply
If objItem.Class = olMail Then
Set olMsg = objItem
If olMsg.BodyFormat = olFormatPlain Then
IsPlainText = True
End If
olMsg.BodyFormat = olFormatHTML

Set olMsgForward = olMsg.Forward
'add the three attachments
With olMsgForward
.Attachments.Add strAtt1
.Attachments.Add strAtt2
.Attachments.Add strAtt3
End With

If IsPlainText = True Then
olMsg.BodyFormat = olFormatPlain
End If
olMsg.Close (olSave)
olMsgForward.Display


'Selected item isn't a mail item
Else
Result = MsgBox("No message item selected. " & _
"Please make a selection first.", _
vbCritical, "Forward in HTML")
GoTo Cleanup
End If


'Cleanup
Cleanup:
Set objOL = Nothing
Set objItem = Nothing
Set objSelection = Nothing
Set olMsg = Nothing
Set olMsgForward = Nothing
Exit Sub
End Sub

[mjcharry]

Hi.

Thanks for the help. It was greatly appreciated. Learning as I go.

Regards,
Michael