Pulling Specified Attachments: VBA

[gmayor]

If there's a security issue the macro won't run at all next time Outlook is opened, so the fact that it does suggests this is not the issue.
Sometimes For Each ... Next loops don't behave well so try

Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
Dim Atmt As Attachment
Dim FileName As String
Dim myExt As String
Dim lngIndex As Long
    For lngIndex = 1 To Item.Attachments.Count
        Set Atmt = Item.Attachments(lngIndex)
        myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
        Select Case myExt
            Case ".pdf"
                FileName = "\\AP Invoices for Processing" & _
                           Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                Atmt.SaveAsFile FileName
            Case Else
        End Select
    Next lngIndex
lbl_Exit:
    Set Atmt = Nothing
    Exit Sub
End Sub

[gazmoz17]

If there's a security issue the macro won't run at all next time Outlook is opened, so the fact that it does suggests this is not the issue.
Sometimes For Each ... Next loops don't behave well so try

Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
Dim Atmt As Attachment
Dim FileName As String
Dim myExt As String
Dim lngIndex As Long
    For lngIndex = 1 To Item.Attachments.Count
        Set Atmt = Item.Attachments(lngIndex)
        myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
        Select Case myExt
            Case ".pdf"
                FileName = "\\AP Invoices for Processing" & _
                           Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                Atmt.SaveAsFile FileName
            Case Else
        End Select
    Next lngIndex
lbl_Exit:
    Set Atmt = Nothing
    Exit Sub
End Sub

Hi I seem to get an error for the section I have highlighted red?

Thanks