Outlook 2013 VB rule to auto save attachments with different file types

[Ruben David]

I have a script in place:

Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Sub PauseApp(PauseInSeconds As Long)
Call AppSleep(PauseInSeconds * 1000)
End Sub

Public Sub saveAttachtoDisk(Item As Outlook.MailItem)

Dim saveFolder As String
saveFolder = "c:\InvItems"

Dim dateFormat
dateFormat = Format(Now, "mmddyyyy-Hmmss")

Dim Subject As Variant
Subject = Item.Subject

Dim objAtt As Outlook.Attachment
For Each objAtt In Item.Attachments
objAtt.SaveAsFile saveFolder & "\" & Subject & "-" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing

Next
PauseApp 3
End Sub

The emails that come to me all have the pretty much the same subject name (Inv Report date of report etc...) the only difference is some come as .xml, xls, and doc.

The .xml files have a very long filename and it can't be changed when it sends to me so I tried to adapt to this by testing this code:

Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Sub PauseApp(PauseInSeconds As Long)
Call AppSleep(PauseInSeconds * 1000)
End Sub
Public Sub saveAttachtoDisk(Item As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim Subject As Variant
Dim strFileExtension As String
saveFolder = "c:\InvItems"
dateFormat = Format(Now, "mmddyyyy-Hmmss")
Subject = Item.Subject

For Each objAtt In Item.Attachments
If InStr(objAtt.DisplayName, ".xml") Then
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName

End If

Set objAtt = Nothing

Next
PauseApp 1
End Sub

This works but when I try to add additional code for the other file types to save with subject & date attached it doesn't work. I only want the .xml files to save as the filename but the other file types I need to keep the subject. I can use the first script and I get all the files save to my drive but the .xml files are not saving. I'm thinking it's because the filename is already long and I can't change this because another script picks up the files based on the subject name. The reason it worked before is because the .xml files weren't in the loop but now I get 15 of them a day that I need to save as well.

This is a rule not a macro because the plan is to have it running on a separate pc when I get this finalized.

Help me Obi Wan you're my only hope.

 

[Michael Bauer]

Simply add an Else command

if (xml) then
  save  as xml
else
  save the other types
endif

 

[Ruben David]

Wow! that worked - duh! but if I wanted to add another file type to that would I write it like this:

Dim objAtt As Outlook.Attachment
For Each objAtt In Item.Attachments
If InStr(objAtt.DisplayName, ".xml", "*.doc") Then
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Else
objAtt.SaveAsFile saveFolder & "\" & Subject & "-" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing

because the .doc files look like this rpfcu.thedate.rp.doc and I need the entire filename

Thank you Michael

 

[Michael Bauer]

You cannot pass two search strings to the Instr function. If all file types have three-digit extension, I'd use this one:

select case right$(objAtt.DisplayName, 4)
case ".xml"
case ".doc"
case else
end select

 

[Ruben David]

Sorry I'm a little more confused and the .doc is actually xxxx.thedate.rp.doc and I need to keep that rp in the save file. I'm just not sure how to use your reference above.

 

[Michael Bauer]

Here

If InStr(objAtt.DisplayName, ".xml", "*.doc") Then

you're trying to search for '.xml' and for '*.doc' in the DisplayName, which doesn't work.

The shown Select Case is a way to do what you want, that is do something if the DisplayName ends with '.xml' or with '.doc', and do something else if it ends with anything else. It doesn't change the DisplayName, it just analyzes it.

If you want to do the same for both '.xml' and '.doc', you can also write it this way:

select case right$(objAtt.DisplayName, 4)
case ".xml", ".doc"
    ' do something
case else
    ' do something else
end select