Преобразование электронных таблиц из папки в PDF (Сохранить в другом месте)

Question

Я хочу выбрать, где сохранять PDF-файлы, а не сохранять их в папке, где находятся файлы Excel.

Я также хочу распечатать только первый лист.

Dims, заканчивающиеся на 2 - это то, что я добавил, чтобы попытаться сделать эту работу. Появляются оба всплывающих окна, но после того, как я выбрал место для сохранения PDF-файлов, происходит сбой при Set objFolder2 = objFileSystem2.GetFolder(strPath2)

Любая помощь очень ценится.

Sub ExcelPlot()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim objWindowsFolder2 As Object
Dim strWindowsFolder As String

'Select the specific Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Locate the Excel files", 0, "")

'Select where to save to
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder2 = objShell.BrowseForFolder(0, "Where would you like to save the PDFs?", 0, "")

If Not objWindowsFolder Is Nothing Then
   strWindowsFolder = objWindowsFolder.self.Path & "\"

   Call ProcessFolders(strWindowsFolder)

   'Open the windows folder
   Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub

Sub ProcessFolders(strPath As String)
Dim strPath2 As String
Dim objFileSystem As Object
Dim objFileSystem2 As Object
Dim objFolder As Object
Dim objFolder2 As Object
Dim objFile As Object
Dim objExcelFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strPath)
Set objFolder2 = objFileSystem2.GetFolder(strPath2)

For Each objFile In objFolder.Files
    strFileExtension = objFileSystem.GetExtensionName(objFile)
    If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
       Set objExcelFile = objFile
       Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)

       strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
       objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=strPath2 & strWorkbookName & ".pdf"

       objWorkbook.Close False
    End If
Next

'Process all folders and subfolders
If objFolder.SubFolders.Count > 0 Then
   For Each objSubFolder In objFolder.SubFolders
       If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
          ProcessFolders (objSubFolder.Path)
       End If
   Next
End If
End Sub

Спасибо

Answer 1

Вы можете сделать что-то вроде этого - вам нужно передать оба пути в ProcessFolders

Sub ExcelPlot()

    Dim sourceFolder As String, destFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Locate the Excel files"
        If .Show = -1 Then
            sourceFolder = .SelectedItems(1)
            .Title = "Where would you like to save the PDFs?"
            If .Show = -1 Then
                destFolder = .SelectedItems(1)
                ProcessFolders sourceFolder, destFolder
                Shell "Explorer.exe" & " " & destFolder, vbNormalFocus
            End If
        End If
    End With
End Sub

РЕДАКТИРОВАТЬ: Вот обновленная (не рекурсивная) версия вашей подпрограммы обработки папок:

Sub ProcessFolders(sourceFolder As String, destFolder As String)

    Dim objFileSystem As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim objWorkbook As Excel.Workbook
    Dim strWorkbookName As String, strFileExtension As String

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Dim colFolders As New Collection

    colFolders.Add sourceFolder

    Do While colFolders.Count > 0

        Set objFolder = objFileSystem.GetFolder(colFolders(1)) 'get the first path
        colFolders.Remove 1 'remove from listing

        'Process files in this folder
        For Each objFile In objFolder.Files

            strFileExtension = objFileSystem.GetExtensionName(objFile)
            If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then

               Set objWorkbook = Application.Workbooks.Open(objFile.Path)

               strWorkbookName = Left(objWorkbook.Name, _
                                     (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
               objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
                  Filename:=objFileSystem.buildpath(destFolder, strWorkbookName & ".pdf")

               objWorkbook.Close False
            End If
        Next

        'Process subfolders
        For Each objSubFolder In objFolder.SubFolders
            If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
               colFolders.Add objSubFolder.Path  'add this to the collection for processing
            End If
        Next

    Loop

End Sub