Fabricio Melos

Em 25/04/2022 às 19:18, wesley.elias disse:

 

 

Prezados estou usando o código abaixo, mas preciso que os arquivos sejam salvos com o campo "Nome" que tem na mala direta. Esse campo refere-se ao nome de cada pessoa da mala direta. alguém pode me ajudar?

 

Sub SaveAsSeparatePDFs()
'Updated by Extendoffice 20180906
Dim I As Long
Dim xStr As String
Dim xPathStr As Variant
Dim xDictoryStr As String
Dim xFileDlg As FileDialog
Dim xStartPage, xEndPage As Long
Dim xStartPageStr, xEndPageStr As String
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show <> -1 Then
MsgBox "Please chose a valid directory", vbInformation, "Kutools for Word"
Exit Sub
End If
xPathStr = xFileDlg.SelectedItems(1)
xStartPageStr = InputBox("Begin saving PDFs starting with page __? " & vbNewLine & "(ex: 1)", "Kutools for Word")
xEndPageStr = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 7)", "Kutools for Word")
If Not (IsNumeric(xStartPageStr) And IsNumeric(xEndPageStr)) Then
MsgBox "The enterng start page and end page should be number format", vbInformation, "Kutools for Word"
Exit Sub
End If
xStartPage = CInt(xStartPageStr)
xEndPage = CInt(xEndPageStr)
If xStartPage > xEndPage Then
MsgBox "The start page number can't be larger than end page", vbInformation, "Kutools for Word"
Exit Sub
End If
If xEndPage > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Then
xEndPage = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
End If
For I = xStartPage To xEndPage
ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & I & ".pdf", _
wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, I, I, wdExportDocumentWithMarkup, _
False, False, wdExportCreateHeadingBookmarks, True, False, False
Next
End Sub

Esse seu código joga todos os documentos em um único arquivo de word e depois separa eles por páginas. Isso não é necessário.

Use este código:

    Dim inicio As Integer
    Dim final As Integer
    Dim caminho As String
    Dim i As Integer
    
    caminho = InputBox("Escreva o caminho da pasta onde deseja salvar")
    inicio = InputBox("Insira o número do primeiro registro a salvar")
    final = InputBox("Insira o número do último registro a salvar")
    

           
    ActiveDocument.MailMerge.DataSource.ActiveRecord = inicio
     
    For i = inicio To final
     ActiveDocument.ExportAsFixedFormat OutputFileName:=caminho & "\" & ActiveDocument.MailMerge.DataSource.DataFields("Nome").Value, _
                                      ExportFormat:=wdExportFormatPDF, _
                                      Range:=wdExportAllDocument
     
     ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
     Next i
    
    MsgBox "Arquivos exportados com sucesso!"

17 horas atrás, Alvarolucasno disse:

Pessoal, muito boa a solução. 

 

Alguém saberia como automatizar o processo de envio dos pdf para o email respectivo da lista ?

Encontrei este tutorial. Acredito que fica fácil adaptar.

https://www.youtube.com/watch?v=Q2esUrarmhY

@Alex_Leite Desculpe a demora em responder

Até alguns dias atrás meu código funcionava normalmente. Porém, de uns dias para cá também começou a apresentar o mesmo problema. Estou tentando identificar ainda o que está acontecendo.

Pessoal, apesar de estar apresentando o mesmo problema que o @Alex_Leite comentou, disponibilizo aqui os fontes da macro que gera os PDFs.

ExportPDFMacro.zip

Boa tarde

Adaptei o código postado pelo Edson e implementei uma solução própria, sem a necessidade de exportar todos os registros antes, você indica os registros e o Word exporta automaticamente, a cada registro exportado, ele busca o próximo registro até o último registro indicado. O nome do arquivo é o nome da pessoa do contrato.

No meu caso, eu criei um form para colocar o caminho do arquivo e os registros de início e fim para exportar.

Segue o código

Private Sub CommandButton1_Click()
    Dim inicio As Integer
    Dim final As Integer
    Dim caminho As String
    Dim i As Integer
    
    caminho = txtCaminho.Value
    inicio = txtInicio.Value
    final = txtFinal.Value
       
    ActiveDocument.MailMerge.DataSource.ActiveRecord = inicio
     
    For i = inicio To final
     ThisDocument.ExportAsFixedFormat OutputFileName:=caminho & ActiveDocument.MailMerge.DataSource.DataFields("Nome_do_Estudante").Value, _
                                      ExportFormat:=wdExportFormatPDF, _
                                      Range:=wdExportAllDocument
     
     ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
     Next i
    MsgBox "Arquivos exportados com sucesso!"
    
End Sub