Hallo allemaal,
Onderstaande vba code gebruik ik voor het automatisch opslaan van de bijlages (pdf formaat) in een bepaalde map in outlook.
Nu wil ik dat die niet alleen de pdf formaat opslaat maar ook de xlsx extensies.
De volgende regel had ik al aangepast:
naar:
De regel eruit halen is geen optie want dan slaat die echt alle bijlages op. Ik wil alleen bepaalde formaten kunnen opslaan.
Iemand een idee hoe ik de code moet aanpassen?
groet
enrico
Onderstaande vba code gebruik ik voor het automatisch opslaan van de bijlages (pdf formaat) in een bepaalde map in outlook.
Code:
Sub SaveAttachmentsToFolder()
' This Outlook macro checks a named subfolder in the Outlook Inbox
' (here the "Sales Reports" folder) for messages with attached
' files of a specific type (here file with an "xls" extension)
' and saves them to disk. Saved files are timestamped. The user
' can choose to view the saved files in Windows Explorer.
' NOTE: make sure the specified subfolder and save folder exist
' before running the macro.
On Error GoTo SaveAttachmentsToFolder_err
' Declare variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Bijlages opslaan") ' Enter correct subfolder name.
i = 0
' Check subfolder for messages and exit of none found
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Sales Reports folder.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' Check each message for attachments
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
' Check filename of each attachment and save if it has "xls" extension
If Right(Atmt.FileName, 3) = "pdf" Then
' This path must exist! Change folder name as necessary.
FileName = "H:\Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item
' Show summary message
If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the H:\Attachments" _
& vbCrLf & vbCrLf & "Have a nice day!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
End If
' Clear memory
SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Handle Errors
SaveAttachmentsToFolder_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume SaveAttachmentsToFolder_exit
End Sub
Nu wil ik dat die niet alleen de pdf formaat opslaat maar ook de xlsx extensies.
De volgende regel had ik al aangepast:
Code:
If Right(Atmt.FileName, 3) = "pdf" Then
naar:
Code:
If Right(Atmt.FileName, 3) = "pdf, xlsx" Then
De regel eruit halen is geen optie want dan slaat die echt alle bijlages op. Ik wil alleen bepaalde formaten kunnen opslaan.
Iemand een idee hoe ik de code moet aanpassen?
groet
enrico