Outlook VBA スクリプト – 添付ファイルの印刷とメールの移動

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

関連情報