0
[email protected]の受信ボックスで特定の件名のメッセージを検索し、デバッグをコンソールに表示するコードがあります。これらのメールの添付ファイルを保存するコードを追加したいと思います検索によってフラグが立てられます。この問題については、MSDNのドキュメントがあいまいでした。添付ファイルを開くと保存する
「でコメントアウトされて###、約12行を下
Sub Search_Inbox()
'This subroutine searchest the RFin Inbox for the prior month's Acting/Additional forms
'Then it saves the .xlsx attachments
Dim objNamespace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim myDestFolder As Outlook.Folder
Dim objFolder As Outlook.MAPIFolder
Dim DestFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String
Dim mon As String
mon = Format(Date - 30, "mmmm")
Set objNamespace = Application.GetNamespace("MAPI")
Set olShareName = objNamespace.CreateRecipient("[email protected]") 'contains secondary address
Set objFolder = objNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox)
Set DestFolder = objNamespace.GetSharedDefaultFolder(olShareName, olFolderToDo)
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & mon & " Acting/Additional Bonus %'"
Set filteredItems = objFolder.Items.Restrict(strFilter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
Found = False
Else
Found = True
' this loop displays the list of emails by subject in the debug console and saves the attachments to the specified folder
dim z as integer
z=0
For Each itm In filteredItems
z=z+1
Debug.Print itm.Subject
'### Insert code here to Open the attachments with .xlsx extensions, if any, in each of the emails found, save them as "[Mon] Acting/Additional Bonus (1 to n).xlsx"
Next
End If
'If the subject isn't found:
If Not Found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
End Sub
をOutlook.Attachmentこのアプローチは素晴らしいでした、必要に応じてifステートメントを変更してください。 –