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

问题描述:

下面的代码在我的收件箱中找到我的Subfolder,然后在活动窗口中打开电子邮件。使用pdf中的字段保存pdf附件

我想"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 
+0

https://meta.stackexchange.com/a/5235/289619 – 0m3r

这应该是...

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)

设置选项明确为关一般不会咕d练习。您可能会在一个或多个位置拼错变量名称,这会在程序运行时导致意外的结果。

+0

的不打开的PDF,但保持关闭我的看法。错误消息:MS Outlook已停止工作。问题导致程序无法正常工作。 – CPmngr

+0

@CPmngr您正在运行哪个Outlook版本? – 0m3r