Consulting

Results 1 to 2 of 2

Thread: Outlook VBA Error 438 When Saving Attachments

  1. #1

    Post Outlook VBA Error 438 When Saving Attachments

    This is my first time working with Outlook vba and I pieced this together for saving all Excel attachments from incoming mail to a local drive folder. It's within the ThisOutlookSession module and I restarted Outlook, and when I send a test email meeting the criteria in the If statements, I just receive "Error 438: Object doesn't support this property or method". I can't figure out which object doesn't support which property or method? It clearly is at least running fine up to my if statements because this is only happening to emails that meet the criteria, but then it won't complete the action of saving the attachment. Can someone tell me what I need to update?

    Option Explicit
    Private WithEvents inboxItems As Outlook.Items
    Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace
    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    End Sub

    Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem

    Dim i As Integer
    Dim strFolder As String
    Dim mySaveName As String
    Dim myExt As String
    Dim OlMail As Outlook.MailItem

    strFolder = "D:\Scripts\VendorProductivity\Daily files"

    If TypeName(Item) = "MailItem" Then
    If Item.Subject Like "*Report*" Then
    If Item.Recipient = "Jane Doe" Then
    If Item.Attachments.Count > 0 Then

    'loop through all attachments
    For i = 1 To Item.Attachments.Count

    mySaveName = Item.Attachments.Item(i).FileName
    myExt = Split(mySaveName, ".")(1)

    'Only save files with named extensions
    Select Case myExt
    Case "xls", "xlsm", "xlsx"
    mySaveName = strFolder & "" & mySaveName
    Item.Attachments.Item(i).SaveAsFile mySaveName

    Case Else
    'do nothing
    End Select
    Next
    Item.Delete
    End If
    End If
    End If
    End If

    ExitNewItem:
    Exit Sub

    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
    End Sub

  2. #2
    There are two obvious issues with your code (not tested)

    1. You need to add "" to your folder path i.e.
    strFolder = "D:\Scripts\VendorProductivity\Daily files\"
    or you get a filepath of D:\Scripts\VendorProductivity\Daily filesworkbook.xlsx which is not valid.

    2. It would be better to use
    myExt = Right(mySaveName, Len(mySaveName) - InStrRev(mySaveName, Chr(46)))
    to extract your extension rather than splitting it as filenames can have more than one period and your code would then produce an 'extension' that would not be matched.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •