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

Question

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
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 < 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

Answer 1

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()