macro foi antes / depois de salvar em .docm

1

Estou trabalhando em um arquivo do Excel que abre um documento de origem (word) que desejo salvar em outro nome, mas com a macro da fonte.
Abrir o arquivo não é o problema, mas após essa mesclagem (estou usando mailmerge) e alterando o nome do documento de origem, as macros desapareceram (antes mesmo de salvar em .docm). No documento de origem, a macro está disponível após a fusão.

alguma ideia é como consertar isso?

O código que eu uso é este:

Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
Dim DocSrc  As String
Dim number As String

number = CStr(ActiveWorkbook.Sheets("MailMerge").Cells(2, 5))

Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = 1

'If Len(Dir("<directory>" & number, vbDirectory)) = 0 Then MkDir "<directory>" & number
fileSaveName = "X:\SAVENAME.docm"
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wdocSource = wd.Documents.Open("<directroy>\Test.docm")

strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

wdocSource.MailMerge.MainDocumentType = wdFormLetters

wdocSource.MailMerge.OpenDataSource _
        Name:=strWorkbookName, _
        AddToRecentFiles:=False, _
        Revert:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM 'MailMerge$' "
          With wdocSource.MailMerge
              .Destination = wdSendToNewDocument
              .SuppressBlankLines = True
                With .DataSource
                     .FirstRecord = wdDefaultFirstRecord
                     .LastRecord = wdDefaultLastRecord
                End With
              .Execute Pause:=False
          End With

   wd.Visible = True

 ' wdocSource.Close SaveChanges:=False
  'wd.ActiveDocument.SaveAs fileSaveName
  'wd.ActiveDocument.Close
Set wdocSource = Nothing
Set wd = Nothing
    
por merger 14.07.2016 / 11:51

0 respostas