Estou tentando fazer um código para gerar um PDF para cada arquivo Excel que eu tenho em uma pasta. Primeiramente meu código gera um PDF cada arquivo excel e depois gera um PDF que seria a capa de todos esses arquivos.
O problema que estou tendo é que gera em arquivos separados, alguém tem ideia de como poderia gerar um arquivo de PDF somente?
Sub BatchOpenMultiplePSTFiles()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim strWindowsFolder As String
Application.ScreenUpdating = False
'Desliga Atualização de Tela
Application.DisplayAlerts = False
'Desliga Alertas
'Select the specific Windows folder
Caminho = ThisWorkbook.Path
'Caminho do Arquivo
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Selecione a pasta com os arquivos" _
& "Excel que deseja transformar em PDF:", 0, "")
If Not objWindowsFolder Is Nothing Then
'Se não selecionar nada, não faz nada
strWindowsFolder = objWindowsFolder.self.Path & "\"
Call ProcessFolders(strWindowsFolder)
'Chama macro para gerar arquivos PDF
Sheets("Capa e Índice").Visible = True
'Aba selecionada para ser gerado pdf
ActiveWorkbook.SaveAs Filename:=strWindowsFolder & "01-Capa.pdf"
'Salva como pdf
Sheets("Capa e Índice").Visible = False
'Oculta Aba
ChDir strWindowsFolder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
'Abrir pasta selecionada
End If
ActiveWorkbook.SaveAs Filename:=Caminho & "\XXX.xlsm",
FileFormat:=xlOpenXMLWorkbookMacroEnabled
'Salva documento com nome original
Application.ScreenUpdating = True
'Liga Atualização de tela
Application.DisplayAlerts = True
'Liga Alertas
MsgBox "Arquivos criados com sucesso"
End Sub
Sub ProcessFolders(strPath As String)
Dim objFileSystem As Object
Dim objFolder 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)
'Para cada arquivo xlsx é gerado um arquivo PDF
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If 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:=strPath & strWorkbookName & ".pdf"
objWorkbook.Close False
End If
Next
'Gerar PDF para subpastas
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