Consulting

Results 1 to 3 of 3

Thread: How To Save Multiple Externsions From Email

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    15
    Location

    How To Save Multiple Extensions 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
    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
    Last edited by VBE313; 01-02-2020 at 06:30 AM.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Mar 2019
    Posts
    15
    Location
    Hi Graham,

    Thank you this works perfect!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •