轉發Outlook電子郵件附件的最佳VB方法是什麼？

Question

我有一套現有的Outlook vb代碼，可以幫助我轉發電子郵件，但他們確實有助於轉發任何附件。任何想法如何包含這些附件？

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

我想這就是你要找的。

Set MailItem.Attachments = objMail.Attachments 

或者更好的是，爲什麼重建整個郵件對象都：

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