** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Word
  Mensajes nuevos Mensajes nuevos RSS - Carta en correspondencia con 2 Hojas
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoCarta en correspondencia con 2 Hojas

 Responder Responder
Autor
Mensaje
lursaildi Ver desplegable
Habitual
Habitual


Unido: 19/Febrero/2008
Estado: Sin conexión
Puntos: 120
Enlace directo a este mensaje Tema: Carta en correspondencia con 2 Hojas
    Enviado: 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
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3381
Enlace directo a este mensaje Enviado: 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
Arriba
lursaildi Ver desplegable
Habitual
Habitual


Unido: 19/Febrero/2008
Estado: Sin conexión
Puntos: 120
Enlace directo a este mensaje Enviado: 12/Noviembre/2020 a las 18:06
OK
Funcione muchas gracias.
cerrar consulta
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable