1

.msg 添付ファイルを含むメールを大量に受け取ります。通常、メールを手動で開き、.msg 添付ファイルを開いて、添付されている .pdf ファイルを取得する必要があります。この形式の電子メールを 200 通以上受信することが多く、すべての PDF ファイルを印刷するには時間がかかります。以下のコードをまとめることができました(オンラインフォーラムから多くの助けを借りて)

Sub SaveOlAttachments()

Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim msg2 As Outlook.MailItem
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim strTmpMsg As String
Dim fsSaveFolder As String

fsSaveFolder = "C:\Users\nicholson.a.9\Desktop\Invoices to Print\"

strFilePath = "C:\temp\"
strTmpMsg = "KillMe.msg"

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("MSG Attachments")
i = 0
If olFolder Is Nothing Then Exit Sub
For Each msg In olFolder.Items

    If msg.Attachments.Count > 0 Then
    While msg.Attachments.Count > 0
    bflag = False
        If Right$(msg.Attachments(1).FileName, 3) = "msg" Then
            bflag = True
            msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
            Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
        End If
        If bflag Then
        i = i + 1
            sSavePathFS = fsSaveFolder & "\" & i & " - " & msg2.Attachments(1).FileName
            msg2.Attachments(1).SaveAsFile sSavePathFS
            msg2.Delete
        Else
            sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName
            msg.Attachments(1).SaveAsFile sSavePathFS
        End If
        msg.Attachments(1).Delete
        Wend
        msg.Delete
    End If
Next
End Sub

コードは機能し、メッセージが添付された電子メールを受信した場合は、その電子メールをコピーして受信トレイの下のサブフォルダー (MSG 添付ファイル) に貼り付け、スクリプトを実行します。私が抱えている問題は、添付ファイルが同じ名前、つまり AT0001 の場合、スクリプトは 1 つの添付ファイルのみを抽出し、他のすべての添付ファイルを残すことです。誰でも助けることができますか?ありがとう

4

1 に答える 1