什么是最好的VB方法来转发outlook电子邮件附件

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