Boa tarde galera! É o seguinte, estou com um problemão, mas não estou conseguindo resolver, pois não tenho conhecimento avançado em VBA, peço por gentileza uma ajuda de vocês. Tenho um modelo de carta no Word que captura alguns campos de uma planilha que tenho no excel, ele captura o campo E-mail e Senha. Até consigo gerar a mala direta, mas quando tenho muitos registros, ele gera em um arquivo só todos os registros e preciso que gere em arquivos .doc separados. Alguém saberia me dizer como fazer isso, mas peço que detalhem o máximo para mim pois sou totalmente novato nesse assunto. Ah detalhe em minhas pesquisas até encontrei algo parecido, mas não consegui fazer funcionar, pois não sei se estou fazendo a coisa certa, o codigo que encontrei esta abaixo em vermelho. Obrigado Galera! CODE Sub SalvaComo Arqs ' Converte todas as seções para subdocumentos TudoParaSubDocs ActiveDocument ' Salva cada subdocumento como um arquivo separado SalvaTodosSubDocs ActiveDocument End Sub CODE 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 CODE 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 CODE 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
