What is the best VB method to forward outlook emails attachments?

I have an existing set of outlook vb codes that help me to forward emails but they do help to forward along with any attachments. any ideas how to include these attachments?

    Private Const FORWARD_TO_EMAIL As String = "your_email@your_domain.com " 

    Private Const START_MESSAGE_HEADER As String = "--------StartMessageHeader--------" 
    Private Const END_MESSAGE_HEADER As String = "--------EndMessageHeader--------" 
    Private Const FROM_MESSAGE_HEADER As String = "From: " 

    Private Const DESKTOP_SWITCHDESKTOP As Long = &H100 
    Private Declare Sub LockWorkStation Lib "User32.dll" () 
    Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long 
    Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" _ 
    (ByVal lpszDesktop As Any, _ 
    ByVal dwFlags As Long, _ 
    ByVal fInherit As Long, _ 
    ByVal dwDesiredAccess As Long) As Long 

  Sub ForwardEmail(MyMail As MailItem) 
    On Error Goto EndSub 

    Dim strBody As String 
    Dim objMail As Outlook.MailItem 
    Dim MailItem As Outlook.MailItem 

    Set objMail = Application.Session.GetItemFromID(MyMail.EntryID) 

     ' Initialize email to send
    Set MailItem = Application.CreateItem(olMailItem) 
    MailItem.Subject = objMail.Subject 

    If (objMail.SenderEmailAddress <> FORWARD_TO_EMAIL) Then 
         ' Only forward emails when the workstation is locked
        If (Not IsWorkstationLocked()) Then 
            Return 
        End If 

         ' Compose email and send it to your other email
        strBody = START_MESSAGE_HEADER + Chr$(13) + _ 
        FROM_MESSAGE_HEADER + objMail.SenderEmailAddress + Chr$(13) + _ 
        "Name: " + objMail.SenderName + Chr$(13) + _ 
        "To: " + objMail.To + Chr$(13) + _ 
        "CC: " + objMail.CC + Chr$(13) + _ 
        END_MESSAGE_HEADER + Chr$(13) + Chr$(13) + _ 
        objMail.body 
        MailItem.Recipients.Add (FORWARD_TO_EMAIL) 

         ' Do not keep email sent to your mobile account
        MailItem.DeleteAfterSubmit = True 
    Else 
         ' Parse the original mesage and reply to the sender
        strBody = objMail.body 
        Dim posStartHeader As Integer 
        posStartHeader = InStr(strBody, START_MESSAGE_HEADER) 
        Dim posEndHeader As Integer 
        posEndHeader = InStr(strBody, END_MESSAGE_HEADER) 

         'Remove the message header from the body
        strBody = Mid(strBody, 1, posStartHeader - 1) + _ 
        Mid(strBody, posEndHeader + Len(END_MESSAGE_HEADER) + 4) 

        Dim originalEmailFrom As String 
        originalEmailFrom = GetOriginalFromEmail(posStartHeader, _ 
        posEndHeader, objMail.body) 
        If (originalEmailFrom = "") Then 
            Return 
        End If 

        MailItem.Recipients.Add (originalEmailFrom) 

         ' Delete email received from your mobile account
        objMail.Delete 
    End If 

     ' Send email
    MailItem.body = strBody 
    MailItem.Send 


     ' Set variables to null to prevent memory leaks
    Set MailItem = Nothing 
    Set Recipient = Nothing 
    Se开发者_如何学Got objMail = Nothing 
    Exit Sub 

EndSub: 
End Sub 


Private Function GetOriginalFromEmail(posStartHeader As Integer, _ 
    posEndHeader As Integer, strBody As String) As String 
    GetOriginalFromEmail = "" 
    If (posStartHeader < posEndHeader And posStartHeader > 0) Then 
        posStartHeader = posStartHeader + Len(START_MESSAGE_HEADER) + 1 
        Dim posFrom As Integer 
        posFrom = InStr(posStartHeader, strBody, FROM_MESSAGE_HEADER) 
        If (posFrom < posStartHeader) Then 
            Return 
        End If 
        posFrom = posFrom + Len(FROM_MESSAGE_HEADER) 
        Dim posReturn As Integer 
        posReturn = InStr(posFrom, strBody, Chr$(13)) 
        If (posReturn > posFrom) Then 
            GetOriginalFromEmail = _ 
            Mid(strBody, posFrom, posReturn - posFrom) 
        End If 
    End If 
End Function 

Private Function IsWorkstationLocked() As Boolean 
    IsWorkstationLocked = False 
    On Error Goto EndFunction 

    Dim p_lngHwnd As Long 
    Dim p_lngRtn As Long 
    Dim p_lngErr As Long 

    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", _ 
    dwFlags:=0, _ 
    fInherit:=False, _ 
    dwDesiredAccess:=DESKTOP_SWITCHDESKTOP) 

    If p_lngHwnd <> 0 Then 
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd) 
        p_lngErr = Err.LastDllError 

        If p_lngRtn = 0 Then 
            If p_lngErr = 0 Then 
                IsWorkstationLocked = True 
            End If 
        End If 
    End If 
EndFunction: 
End Function

I think this is what you are looking for.

 Set MailItem.Attachments = objMail.Attachments

Or better yet, why rebuild the whole mail object at all:

 Set MailItem = objMail.Forward()
 MailItem.Recipients.Add(FORWARD_TO_EMAIL)
 MailItem.Send()