title: What is the best VB method to forward outlook emails attachments?
body: <p>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?</p>
  
  <pre><code>    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 = &amp;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 &lt;&gt; 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 
      Set objMail = Nothing 
      Exit Sub 
  
  EndSub: 
  End Sub 
  
  
  Private Function GetOriginalFromEmail(posStartHeader As Integer, _ 
      posEndHeader As Integer, strBody As String) As String 
      GetOriginalFromEmail = "" 
      If (posStartHeader &lt; posEndHeader And posStartHeader &gt; 0) Then 
          posStartHeader = posStartHeader + Len(START_MESSAGE_HEADER) + 1 
          Dim posFrom As Integer 
          posFrom = InStr(posStartHeader, strBody, FROM_MESSAGE_HEADER) 
          If (posFrom &lt; posStartHeader) Then 
              Return 
          End If 
          posFrom = posFrom + Len(FROM_MESSAGE_HEADER) 
          Dim posReturn As Integer 
          posReturn = InStr(posFrom, strBody, Chr$(13)) 
          If (posReturn &gt; 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 &lt;&gt; 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
  </code></pre>