Hola. En un principio la siguiente "macro" crearía una subcarpeta (documentos) y en ella tantos documentos como destinatarios.
Public Sub guardaDocsseparados() Dim misreg As Long Dim mnom As String Dim nn As Long Dim midoc As Document
If Dir(ActiveDocument.Path & "/documentos/", vbDirectory) = "" Then MkDir ActiveDocument.Path & "/documentos/" End If
DoEvents ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False DoEvents ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord misreg = ActiveDocument.MailMerge.DataSource.RecordCount mnom = ActiveDocument.Path & "\documentos\" & Replace(ActiveDocument.Name, ".docm", "") DoEvents Set midoc = ActiveDocument For nn = 1 To misreg midoc.Activate 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 mnom & "_" & midoc.MailMerge.DataSource.DataFields(1) & ".docx" ActiveDocument.Close savechanges:=False DoEvents midoc.Activate ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord Next ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord ActiveDocument.MailMerge.ViewMailMergeFieldCodes = True End Sub
El nombre de los documentos se diferencia por el valor del primer "campo" de combinación. En el word 19 ha funcionado, pero..... El código está hecho a título de ejemplo y tiene falta de comprobar, depurar etc etc. Seguro que hay soluciones más fáciles. Espero que ayude a resolver la duda Ya comentas. Un saludo a todos
|