×
Ir ao conteúdo
  • Cadastre-se

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


pedroch
Ir à solução Resolvido por Basole,

Posts recomendados

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?

 

image.png.05ce9974738e4c71413888e0b75bf46b.png

 

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

image.png

Link para o comentário
Compartilhar em outros sites

  • Solução

@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"

 

Link para o comentário
Compartilhar em outros sites

@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? 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!