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