請幫忙，嘗試將我的默認檔案夾更改為另一個郵箱，并且也僅根據不同的主題過濾器提取 csv 檔案。下面是我的代碼。如果我使用 displayname 來設定物件，我會收到錯誤訊息。目前它從我的收件箱中提取。非常感謝您的幫助
Public Sub Download_Attachments()
Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.NameSpace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim saveFolder As String
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String, sFolderName As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
saveFolder = "C:\Users\pmulei\Desktop\test" & "\" & sFolderName
subjectFilter = "Price"
displayname = "xlsm"
OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo Err_Control
If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If
Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders.outItem("Global Real Time").Folder.outItem("Inbox")
If Not outFolder Is Nothing Then
For Each outItem In outFolder.Items
If outItem.Class = Outlook.OlObjectClass.olMail Then
Set outMailItem = outItem
If InStr(1, outMailItem.subject, subjectFilter) > 0 Then 'removed the quotes around subjectFilter
If outMailItem.ReceivedTime >= Date Then
For Each outAttachment In outMailItem.Attachments
If Dir(saveFolder, vbDirectory) = "" Then fso.CreateFolder (saveFolder)
If InStr(outAttachment.filename, displayname) > 0 Then
outAttachment.SaveAsFile saveFolder & outAttachment.filename
Set outAttachment = Nothing
Next
End If
End If
End If
End If
Next
End If
If OutlookOpened Then outApp.Quit
Set outApp = Nothing
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Suenter code here
uj5u.com熱心網友回復：
正確識別代碼是一種很好的做法。嘗試替換這部分代碼。
Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.Folders.Item("Global Real Time").Folders.Item("Inbox")
If Not outFolder Is Nothing Then
For Each outItem In outFolder.Items
If outItem.Class = Outlook.OlObjectClass.olMail Then
Set outMailItem = outItem
If InStr(1, outMailItem.Subject, subjectFilter) > 0 Then 'removed the quotes around subjectFilter
If outMailItem.ReceivedTime >= Date Then
For Each outAttachment In outMailItem.Attachments
If Dir(saveFolder, vbDirectory) = "" Then fso.CreateFolder (saveFolder)
If InStr(outAttachment.Filename, DisplayName) > 0 Then
outAttachment.SaveAsFile saveFolder & outAttachment.Filename
Set outAttachment = Nothing
End If
Next
End If
End If
End If
Next
End If
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/345288.html
上一篇：在VBA中組合ForEach回圈
下一篇：繪制非客戶區的問題-Win32