我如何直接到另一个邮箱，也只拉XLSM文件

Question

请帮助，试图改变我的默认文件夹到另一个邮箱，也只拉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:UserspmuleiDesktoptest" & "" & 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

Answer 1

正确识别代码是一种很好的做法。请尝试替换这部分代码。

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