☰

Outlook VBA 脚本 – 打印附件和移动电子邮件

tag-icon • tag-icon email microsoft-outlook vba printing
Outlook VBA 脚本 – 打印附件和移动电子邮件

我是 VB 脚本的新手，因此需要很多帮助。

最近对电子邮件帐户的更改意味着收到的电子邮件将被移动到收件箱以外的文件夹，这是一条我没有输入且无法更改的规则，我们称之为Folder_X。

我想要做的是自动打印 Folder_X 中带有附件的任何电子邮件的附件。打印完附件后，将电子邮件移至另一个文件夹 (Folder_Y)。任何没有附件的电子邮件都不应移动。

以前，我能够对收到的邮件使用规则，如果邮件带有附件，则将其移动到 Folder_Y，然后运行我在互联网上找到的以下脚本来打印附件。但是，有了这个我没有输入内容的新规则设置，我就不能再使用以前的规则了，因为规则仅适用于入站/出站邮件，而不适用于文件夹 (Folder_X) 中的邮件。

Sub LSPrint(Item As Outlook.MailItem)
    On Error GoTo OError

    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String

    Set oFS = New FileSystemObject
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
    'creates a special temp folder
    cTmpFld = sTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)

    'save & print
    Dim oAtt As Attachment

    For Each oAtt In Item.Attachments
      FileName = oAtt.FileName
      FullFile = cTmpFld & "\" & FileName

      'save attachment
      oAtt.SaveAsFile (FullFile)

      'print attachment
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.NameSpace(0)
      Set objFolderItem = objFolder.ParseName(FullFile)
      objFolderItem.InvokeVerbEx ("print")
    Next oAtt

    'Cleanup

    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing

OError:

    If Err <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Err.Clear
    End If

    Exit Sub
End Sub

如果您能提供任何关于如何调整此脚本以使其在文件夹上运行的建议或其他方法，我们将不胜感激。

答案1

您可以使用 ItemAdd 事件在项目进入文件夹后运行代码。

Option Explicit

'  In ThisOutlookSession
Private WithEvents addedItems As Items

Private Sub Application_Startup()
    ' Add as many  .folders(subfolder name) as is needed to navigate to the folder
    Set addedItems = Session.GetDefaultFolder(olFolderInbox).folders("folder_X").Items
End Sub

Private Sub addedItems_ItemAdd(ByVal Item As Object)

    Dim oAtt As attachment

    If Item.Attachments.count > 0 Then

        Debug.Print "Processing " & Item.subject

        For Each oAtt In Item.Attachments
            Debug.Print "Processing attachment."
        Next oAtt

        Item.move Session.GetDefaultFolder(olFolderInbox).folders("folder_Y")

    End If

End Sub

相关内容