Excel Macro salvar em pdf com nome variável (dinâmico)

pedroch · 25 de outubro de 2021

Olá,

Estou elaborando uma macro que gera um arquivo em pdf das planilhas do arquivo em excel e o salva em uma pasta determinada e além disso abre o Outlook, anexa este arquivo e já dispara um email para contatos pré-determinados.

No entanto, estou tendo dificuldade na questão de salvar o arquivo PDF. Não estou conseguindo fazer com que para cada solicitação da macro, seja gerado um nome diferente para o arquivo pdf para que se tenha o registro individual deles na pasta e não salve em cima do arquivo anterior por ele ter o mesmo nome. Gostaria de fazer com que a macro salvasse o arquivo em pdf com um nome variável ou dinâmico porém não encontrei nenhum jeito para fazer isso. Existe algum jeito de fazer isso facilmente? Poderia salvar o nome do arquivo no estilo "solicitação 12021932" (número aleatório gerado para diferenciar os arquivos).

Segue abaixo a macro que desenvolvi até então!

Sub email()
    Sheets("Banco de dados 1").Select
    'Sheets("email").Select
    With Sheets("Banco de dados 1") '<--| reference "source" sheet (change "SourceSheetName" to your actual "source" sheet name)
        ' find last row with data in column A , skip empty cells in the middle
        With Range(.Cells(.Rows.Count, "A").End(xlUp), _
                   .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Columns.Count).End(xlToLeft)) '<--| reference its range from its column A last not empty cell to this latter cell row last not empty cell
            Worksheets("email").Range("A2").Resize(, .Columns.Count).Value = .Value '<--| paste values to "target" sheet starting from its cell A1 (change "TargetSheetName" to your actual "target" sheet name)
        End With
    End With
    'Sheets(Array("email")).Select
Sheets("Banco de dados 1").Visible = False
Dim NomPastTrab As String
NomPastTrab = VBA.Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
autor = UCase(Application.UserName)
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.path & "\" & NomPastTrab & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
      
End Sub

Sub Gerar_email()
     
'Criar email padrão e anexar arquivo pdf
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
   Dim email As String
   Dim cc As String
 
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.CreateItem(olMailItem)
    Set myAttachments = myItem.Attachments
    
  '  If MsgBox("Foi enviado a prévia para aprovação antes do envio deste email?", vbYesNo) = vbYes Then

    With myItem
    .Display
    End With
        Signature = myItem.HTMLbody


    With myItem
    .To = email
        .To = "  XXXXXX"
        .cc = "XXXXX; XXXXXXX"
        .Subject = "XXXXXXXX"
      .HTMLbody = "" & _
        "<body font=Arial;style=font-size:14.5px; line-height: 1>Bom dia, </font></th></tr><br><br>" & _
        "Segue em anexo o pdf com a solicitação.<br><br> " & Range("a10000").Value & _
        Signature & _
        .Display
                 
       Dim nomeplanilha As String
       Dim path As String
       path = ThisWorkbook.path
       nomeplanilha = VBA.Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & ".pdf"
        .Attachments.Add path & "\" & nomeplanilha

      End With
    
    
    ActiveWorkbook.Save
     
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    Sheets("email").Visible = False
    Sheets("plan1").Select
     
End Sub

Midori · 25 de outubro de 2021

Você fazer um contador para acrescentar +1 a medida que vai salvando, p.ex: Arquivo1.pdf, Arquivo2.pdf. Outro formato poderia ser com data e hora no nome.