Question

以下代码从我的收件箱中找到我的Subfolder，然后在活动窗口中打开电子邮件。

我想 "Open" 此电子邮件附带的pdf表单，以便我可以使用pdf表单中的一个文本字段保存附件

我能找到的唯一代码会将附件保存到临时文件夹，但不会从pdf表单中获取内容。

Sub OpenMailAttachment()

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder 
    Dim openMsg As Outlook.MailItem    
    Dim mySubFolder As MAPIFolder
    Dim myAttachment As Outlook.Attachment
    Dim FileName As String    
    Dim myInspector As Outlook.Inspector

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set mySubFolder = Inbox.Folders("PdfTest")

    mySubFolder.Display

    Set openMsg = mySubFolder.Items(1)

    openMsg.Display

    mySubFolder.Application.ActiveExplorer.Close

    openMsg.Application.ActiveWindow  

    For Each myAttachment in Item.Attachment 
        FileName = "C:\temp\" & myAttachment.FileName

        myAttachment.SaveAsFile FileName

        myAttachment = openMsg.Attachments.Item.DisplayName 
        '(I get Compile error: *.Item* argument not optional)

        myAttachments.Application.ActiveInspector.Display

End Sub

Answer 1

这应该......

Option Explicit
' use  Declare PtrSafe Function with 64-bit Outlook
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hwnd As Long, _
  ByVal lpOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long _
) As Long

Sub OpenMailAttachment()
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim openMsg As Outlook.MailItem
    Dim mySubFolder As MAPIFolder
    Dim Attachment As Outlook.Attachment
    Dim myAttachments As Outlook.Attachments
    Dim FileName As String
    Dim myInspector As Outlook.Inspector
    Dim Item As Object
    Dim sFileType As String

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set mySubFolder = Inbox.Folders("PdfTest")

    mySubFolder.Display

    Set openMsg = mySubFolder.Items(1)

    openMsg.Display
    mySubFolder.Application.ActiveExplorer.Close
    openMsg.Application.ActiveWindow

    Set myAttachments = openMsg.Attachments

    If myAttachments.Count Then
        For Each Attachment In myAttachments
            'Last 4 Characters in a Filename
            sFileType = LCase$(Right$(Attachment.FileName, 4))

            Select Case sFileType
                ' Add additional file types below
                Case ".pdf" ', ".doc", "docx", ".xls"

                FileName = "C:\temp\" & Attachment.FileName
                Attachment.SaveAsFile FileName
                ShellExecute 0, "open", FileName, vbNullString, vbNullString, 0
            End Select
        Next
    End If


End Sub

<强> Option Explicit Statement (Visual Basic)

_{将选项显式设置为关闭通常不是一个好习惯。您可能会在一个或多个位置拼错变量名称，这会在程序运行时导致意外结果。}

使用pdf中的字段保存pdf附件

1 个答案: