How To Save Multiple Externsions From Email

[VBE313]

Error in Title, Should
I have the following code that saves only .pdf. Is there a way I can add multiple extensions? See Example Code


Real Code

If InStr(objAtt.FileName, ".pdf") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".pdf"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
End If

Example Code

If InStr(objAtt.FileName, ".pdf") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".pdf", ".zip", ".xlsx", ".xlsm"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
End If

I tried declaring a Variant but it is saving the ".gif" for some reason


fileExtension = Array(".pdf", ".zip", ".dwg", ".dxf", ".stp", ".step", ".igs", ".xlsx", ".xlsb", ".xlsm")

Here is what I think I need to do


If InStr(objAtt.FileName, ".pdf") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".pdf"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".zip") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".zip"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".dwg") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".dwg"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".dxf") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".dxf"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".stp") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".stp"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".step") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".step"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".igs") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".igs"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".xlsx") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".xlsx"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".xlsm") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".xlsm"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
ElseIf InStr(objAtt.FileName, ".xlsb") > 0 Then
strName = Left(objAtt.FileName, (InStrRev(objAtt.FileName, Chr(46))) - 1) & ".xlsb"
objAtt.SaveAsFile saveFolder & strName 'THIS SAVES THE FILE
End If

[gmayor]

I suspect that what you want is


FileExtension = Array(".pdf", ".zip", ".dwg", ".dxf", ".stp", "step", ".igs", "xlsx", "xlsb", "xlsm")


For j = 1 To olItem.Attachments.Count
Set olAttach = olItem.Attachments(j)
strFname = olAttach.fileName
For k = 0 To UBound(FileExtension)
If Right(strFname, 4) = FileExtension(k) Then
olAttach.SaveAsFile strSaveFldr & strFname
Exit For
End If
Next k
Next j

[VBE313]

Hi Graham,

Thank you this works perfect!