如何检查文件类型和打开/保存文件夹中的文件 VBA

Question

The following code loops through All files in a specified folder, formats each file, and saves it as a PDF in the same folder.

The code runs fine but there are 2 issues:

1)if there are any files in the folder that are already pdf,s it will open in and mess it up. How can I make this so it only opens the excel files in the folder and not PDF files?

2)if I run it twice it works but it just saves over files if the filename already exists. How can I make I so if when it saves it and the file name already exists it saves it as a new file like filename-b, filename-c filename-d, filename-f ect?

Sub File_Loop_Example()
   
    Dim MyFolder As String, MyFile As String

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.clear
    End With

    MyFile = Dir(MyFolder & "\", vbReadOnly)

    Do While MyFile <> ""
        DoEvents
        On Error GoTo 0
        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
        
        Application.Run "PERSONAL.XLSB!TTDA"
        ChDir MyFolder
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        MyFolder & "\" & MyFile, Quality:= _
        xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
        
      0
        Workbooks(MyFile).Close SaveChanges:=False
        MyFile = Dir 
    Loop

    End Sub

Answer 1

Try replacing of

MyFile = Dir(MyFolder & "\", vbReadOnly)

with

MyFile = Dir(MyFolder & "\" & "*.xlsx")

In this way, the code will open only .xlsx files.

Or you can let your code like it is, but filter the files to be open using the next function which retrieves the file extension:

Private Function GetExt(fileName As String) As String
   GetExt = Split(fileName, ".")(UBound(Split(fileName, ".")))
End Function

The function can be called just before the workbook opening. Your loop will become something like this:

Do While MyFile <> ""
     DoEvents
     If GetExt(MyFile) = "xlsx" or GetExt(MyFile) = "xlsm" then
        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
        
        Application.Run "PERSONAL.XLSB!TTDA"
        ChDir MyFolder
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        MyFolder & "\" & MyFile, Quality:= _
        xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
        OpenAfterPublish:=True
        
        Workbooks(MyFile).Close SaveChanges:=False
     End if
     MyFile = Dir 
 Loop

For the next issue, use please:

Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(MyFolder & "\" & MyFile & ".pdf") Then
       If fso.FileExists(MyFolder & "\" & MyFile & "_b.pdf") Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
              MyFolder & "\" & MyFile & "_a", Quality:= _
              xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
       Else
          ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
              MyFolder & "\" & MyFile & "_b", Quality:= _
              xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
        End If
    Else
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
            MyFolder & "\" & MyFile, Quality:= _
            xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
    End If