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

Question

以下代码循环遍历指定文件夹中的所有文件，格式化每个文件，并将其保存为同一文件夹中的 PDF。

代码运行良好，但有两个问题：

1）如果文件夹中有任何文件已经是 pdf，它将打开并搞砸。 我怎样才能做到这一点，所以它只打开文件夹中的 excel 文件而不是 PDF 文件？

2）如果我运行它两次它可以工作，但如果文件名已经存在，它只会保存文件。 如果当它保存它并且文件名已经存在时，我怎么能将它保存为一个新文件，如文件名-b、文件名-c、文件名-d、文件名-fect？

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

尝试更换

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

和

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

这样，代码将只打开.xlsx文件。

或者您可以让您的代码保持原样，但使用检索文件扩展名的下一个 function 过滤要打开的文件：

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

function 可以在工作簿打开之前调用。 你的循环会变成这样：

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

对于下一个问题，请使用：

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