Este fórum está sendo desativado

[murilof93]

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