Ekleri açma ve kaydetme

Question

Belirli bir konudaki iletiler için rfin@example.com gelen kutusunu araştıran bir kodum var ve daha sonra hata ayıklama konsola konuyu yazdırıyor, Bu e-postaların eklerini kaydeden bir kod eklemek istiyorum arama tarafından işaretlendi. MSDN belgeleri bu konuda belirsizdi.

'ile iptal edilmiştir ile ### yaklaşık 12 satırları alt

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("rfin@example.com") '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 

Answer 1

aşağıdaki gibi bir şey deneyin İmdat arıyorum alan: olarak eklemek bildirmek sonra

for each attach in itm.Attachments 
    if (attach.Type = olByValue) or (attach.Type = olEmbeddeditem) Then 
    attach.SaveAsFile "c:\temp\" & itm.FileName 
    End If 
next