please help, trying to change my default folder to another mailbox and also only pull csv files, based on different subject filters. below is my code. i am getting error if i use displayname to set object. and currently its pulling from my inbox. will really appreciate your assistance

    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

CodePudding user response：

It's a good practice to ident the code properly. Try to replace this part of your code.

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