Excel Macro não salva os arquivos nas suas respectivas pastas

[pedroch]

Olá a todos da comunidade,

 

Desenvolvi uma macro que atendesse minha necessidade de salvar todos os arquivos com extensão xls, xlsm, xlsx em pdf (primeira planilha apenas) contidos na pasta selecionada (e subpastas dentro dela).

Ela está funcionando, porém quando existem muitas subpastas a macro não salva o pdf dentro da respectiva subpasta do arquivo, mas sim na pasta "mãe" conforme a foto abaixo:

Tem alguma maneira de resolver esse probleminha?

 

 

Segue o código:

 

Sub BatchOpenMultiplePSTFiles()
    Dim objShell As Object
    Dim objWindowsFolder As Object
    Dim strWindowsFolder As String
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = False
    ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationManual

    'Select the specific Windows folder
    Set objShell = CreateObject("Shell.Application")
    Set objWindowsFolder = objShell.BrowseForFolder(0, "Selecione a pasta que contenha os arquivos Excel que deseja salvar em PDF:", 0, "")

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

       Call ProcessFolders(strWindowsFolder)

       'Open the windows folder
       Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
       MsgBox "Concluído com sucesso!"
   End If
   
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
    
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)

    For Each objFile In objFolder.Files
    
        strFileExtension = objFileSystem.GetExtensionName(objFile)
        
        If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Or LCase(strFileExtension) = "xlsm" Then
           Set objExcelFile = objFile
           Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)
           On Error Resume Next
           'Selecionar quais abas salvar em PDF. Neste caso, somente a primeira; Se quiser outras, setar Array(1,2,3,...)
           objWorkbook.Sheets(Array(1)).Select
           
           strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strWorkbookName & ".pdf", _
                        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                        :=False, OpenAfterPublish:=False
           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

[Basole]

@pedroch experimenta substituir, na linha que exporta para PDF, strPath por:

 

Vba.Left(objExcelFile.Path, vba.InStrRev(objExcelFile.Path, "\") - 1)

 

[pedroch]

@Basole Olá, fiz o que você sugeriu e o problema ainda persiste, ainda está salvando na pasta "mãe" ...

 

Pus em anexo a planilha caso ajude para verificar... 

Salvar em massa Excel em PDF.7z

[Basole]

@pedroch me desculpe, faltou eu incluir uma [ \ ] barra contrario antes do nome do arquivo al ser salvo.

Segue a linha completa corigida.

Substitua por essa:

 

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=VBA.Left(objExcelFile.Path, VBA.InStrRev(objExcelFile.Path, "\") - 1) & "\" & strWorkbookName & ".pdf"

 

[pedroch]

@Basole Olá, agora deu certo! Muito obrigado!

 

O código está rodando muito bem, porém tenho mais algumas outras dúvidas, caso saiba me responder... É necessário abrir um novo tópico? Sou novo na comunidade

@Basole Outra coisa, testando aqui em uma pasta na minha área de trabalho, ela funciona certinho porém ela acaba salvando um pdf fora da pasta, na área de trabalho, como se escapasse um pdf. Como resolveria isso?