Como faço para salvar os arquivos criados em Mala Direta com nomes ligados ao banco de dados?

[Má1]

Bom dia!

Ao criar os documentos com Assistente de Mala Direta não achei opção para salvar os arquivos criados individualmente conforme as informações do banco de dados. Aí se torna necessário renomeá-los um por um. Existe a possibilidade de configurar para que se salve e nomeie cada arquivo gerado conforme as informações do banco de dados?

[vbarbosa]

Quando mandar imprimir os arquivos da mala direta individualmente, você escolhe “Gerar o nome do arquivo a partir do banco de dados” selecione o nome correspondente ao nome do campo no banco de dados EX. , assim cada arquivo será nomeado com o nome da pessoa que consta no banco de dados.

[Beto]

Ao criar um arquivo de mala direta, você o salva o arquivo gerador. Por exemplo: de uma página de ofício circular que irá mesclar com 100 registros irá gerar cem folhas. Você poderá salvar um novo arquivo de cem páginas mas, não serão 100 arquivos de uma página cada um que serão gerados.

[thiagoSB]

Após muita pesquisa consegui adaptar um código que atende a essa finalidade. Segue:

Para facilitar a execução do código, depois de pronto, você associa ele a um botão no word indo em Arquivo>opções>barra de ferramentas de acesso rápido> Escolher comando em:Macros e adicionar>>

Sub salvamaladireta()
Application.ScreenUpdating = False
Dim qtde As Integer
Dim nomeArquivo As String
Dim registro As Integer
Dim nomearquivouniorg As String


ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

qtde = ActiveDocument.MailMerge.DataSource.RecordCount

For registro = 1 To qtde

nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("NAME").Value 'no lugar de NAME voce colona o     nome da coluna da sua base de dados'
nomearquivouniorg = ActiveDocument.MailMerge.DataSource.DataFields("Uniorg").Value 'no luga de Uniorg voce colona     o nome da coluna da sua base de dados'

With ActiveDocument.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
    End With
    .Execute Pause:=False
End With
ActiveDocument.SaveAs2 FileName:="C:\Users\Thiago_2\Desktop\Example Merge Document\TERMO ADITIVO DE CONTRATO - " & nomearquivouniorg & " - " & " " & nomeArquivo & ".docx", FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15
    'O trecho C:\Users\Thiago_2\Desktop\Example Merge Document\TERMO ADITIVO DE CONTRATO - voce deve substituir pelo diretorio da sua pasta onde ira salvar os arquivos. A parte TERMO ADITIVO DE CONTRATO o inicio do nome do documento. Um inicio fixo que sera igual para todos'
ActiveWindow.Close
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

Next registro
Application.ScreenUpdating = True
End Sub