Imprimir página | Cerrar ventana

Carta en correspondencia con 2 Hojas

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Word
Descripción del foro: Foro de Word
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=85597
Fecha de impresión: 19/Abril/2024 a las 13:33


Tema: Carta en correspondencia con 2 Hojas
Publicado por: lursaildi
Asunto: Carta en correspondencia con 2 Hojas
Fecha de publicación: 12/Noviembre/2020 a las 10:56
Tengo una carta en Word con correspondencia en dos hojas y 40 destinatarios, quisiera guardar en una carpeta individualmente para cada destinatario, e encontrado una macro para poder hacerlo, pero esta macro solo lo hace con la primera hoja hay alguna otra forma de hacerlo que coja más de una hoja.

Gracias



Respuestas:
Publicado por: prga
Fecha de publicación: 12/Noviembre/2020 a las 16:52
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


Publicado por: lursaildi
Fecha de publicación: 12/Noviembre/2020 a las 18:06
OK
Funcione muchas gracias.
cerrar consulta



Imprimir página | Cerrar ventana