Visual Basic VBA sobrepondo arquivos com o mesmo nome.

[Rafael Mühlmann]

Bom dia

 

Tenho uma vba que salva todas as minhas abas da planilha excel em pdf baseado no conteúdo da célula x24, porém se esse conteúdo se repete em duas abas, o pdf gerado primeiro é substituído pelo segundo gerado, e eu fico sem o primeiro pdf.

Alguém consegue inserir uma variável para que o código analise se já existe um pdf com o nome que se pretende salvar, e se positivo, que seja acrescentado um (1), (2), (3) e quantos sejam necessários enquanto houver repetição?

 

o vba é o seguinte:

 

Sub salvaPDF()
    Dim listaAbas() As String
    Dim contador As Long, Item As Long, vAba As Long
    Dim caminhoSalvar As String, nomeArquivo As String, vLista As String
    Dim caixaSalvar As Office.FileDialog
   
    Set caixaSalvar = Application.FileDialog(msoFileDialogFolderPicker)
   
        With caixaSalvar
            .AllowMultiSelect = False
            .Title = "Selecione o local para salvar"
            .Show
        End With
   
        If caixaSalvar.SelectedItems.Count = 0 Then
            MsgBox "Operação cancelada!", vbExclamation, "Salvar PDF"
            Exit Sub
        Else
            caminhoSalvar = caixaSalvar.SelectedItems(1) & "\"
           
            contador = 0
           
            With ThisWorkbook
                ReDim listaAbas(.Sheets.Count)
               
                For vAba = 1 To .Sheets.Count
                    .Sheets(vAba).Activate
                    nomeArquivo = .Sheets(vAba).Cells(24, "X")
                       
                        If nomeArquivo = "" Then
                            contador = contador + 1
                            listaAbas(contador) = .Sheets(vAba).Name
                        Else
                            nomeArquivo = nomeArquivo & ".pdf"
                           
                            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                            CStr(caminhoSalvar & nomeArquivo), Quality:=xlQualityStandard, _
                            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                            False
                        End If
               
                Next
               
                For Item = LBound(listaAbas) To UBound(listaAbas)
                    If listaAbas(Item) <> "" Then
                        vLista = vLista & listaAbas(Item) & vbCrLf
                    End If
                Next
               
                If vLista = "" Then
                    MsgBox "Operação concluída com sucesso!", vbInformation, "Salvar em PDF"
                Else
                    MsgBox "A(s) seguinte(s) aba(s) não foi(ram) salva(s) em PDF :" & Chr(13) & Chr(13) & vLista & _
                    Chr(13) & "Favor verifique se na(s) aba(s) listada(s) a célula de referência está preenchida!", vbExclamation, "Erro"
                End If
            End With
    End If
End Sub

 

[Midori]

Já fiz uma macro com essa função.

 

Este é o bloco onde basicamente faço o incremento na parte do nome do arquivo entre parênteses.

 

R = StrReverse(A)
N = StrReverse(Mid(R, InStr(R, "(") + 1, Len(R)))
R = StrReverse(Mid(R, InStr(R, ")") + 1, InStr(R, "(") - 2))
            
If IsNumeric(R) Then
    While Fso.FileExists(P & N & "(" & R & ")." & E)
        R = R + 1
    Wend
    Nome = N & "(" & R & ")." & E
End If

Obs: Variável "A" é o nome do arquivo sem extensão, "P" é a pasta e "E" a extensão.

 

[Rafael Mühlmann]

@Midori obrigado pela dica...mas não deu certo...ao menos eu não consegui fazer rodar.