.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 つの添付ファイルのみを抽出し、他のすべての添付ファイルを残すことです。誰でも助けることができますか?ありがとう