Vertao

Utilizo uma mala direta no word, em que a matriz é um ofício que busca dados de um arquivo no excel, como destinatário, endereço, doctos, etc. Minha necessidade é de que ao rodar a mala direta, seja gerado um arquivo (sub arquivo) para cada destinatário, pois além de impressão, preciso desses contratos arquivados no micro. Tenho o código em vba abaixo, porém não está funcionando direito, pois em vez de pegar realmente cada seção do docto mesclado e gerar um arquivo (janela), ele está gerando arquivo pro cabeçalho, destinatário, linhas em branco, etc, etc, gerando mais arquivos do que deveria. Gostaria que alguém me ajudasse. Sub SalvaComo() ' Converte todas as seções para subdocumentos TudoParaSubDocs ActiveDocument ' Salva cada subdocumento como um arquivo separado SalvaTodosSubDocs ActiveDocument End Sub Sub TudoParaSubDocs(ByRef doc As Word.Document) Dim ctaSec As Long Dim NrSecs As Long NrSecs = doc.Sections.Count ' Inicial pelo final porque a criação de ' Subdocs iinsere seções adicionais For ctaSec = NrSecs - 1 To 1 Step -1 doc.Subdocuments.AddFromRange doc.Sections(ctaSec).Range Next ctaSec End Sub Sub SalvaTodosSubDocs(ByRef doc As Word.Document) Dim subdoc As Word.Subdocument Dim NovoDoc As Word.Document Dim ContaDocs As Long ContaDocs = 1 ' Deve estar em Exibir Mestre para trabalhar com ' Subdocs como arquivos separados doc.ActiveWindow.View = wdMasterView For Each subdoc In doc.Subdocuments Set NovoDoc = subdoc.Open ' Remove as quebras de seção Próxima Página ' Geradas pela fusão dos arquivos RemoveQuebrasSec NovoDoc With NovoDoc .SaveAs FileName:="Arquivo" & CStr(ContaDocs) .Close End With ContaDocs = ContaDocs + 1 Next subdoc End Sub Sub RemoveQuebrasSec(doc As Word.Document) With doc.Range.Find .ClearFormatting .Text = "^b" With .Replacement .ClearFormatting .Text = "" End With .Execute Replace:=wdReplaceAll End With End Sub