How To Save Multiple Externsions From Email

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

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

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

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
        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

---

I suspect that what you want is

Code:

---

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

---

Hi Graham,

Thank you this works perfect!