☰

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

相關內容