Fernanda Marques de Araujo

Consegui configurar um código que gera todos os relatórios individuais (pedi ajuda ao chat GPT) Sub SalvaDocumentosIndividuais() Const Caminho = "\\SRV-1383\estagiarios\TAREFAS_SAJ\QUEIMADAS\2024\LAUDOS\" Dim MainDoc As Document Dim NovoDoc As Document Dim i As Long Dim NomeArquivo As String Dim Identificador As String ' Definir o documento principal Set MainDoc = ActiveDocument ' Executar a mala direta para cada registro da fonte de dados For i = 2 To MainDoc.MailMerge.DataSource.recordCount ' Mover para o registro específico MainDoc.MailMerge.DataSource.ActiveRecord = i ' Obter o valor da coluna "A" (assumindo que é a primeira coluna) Identificador = MainDoc.MailMerge.DataSource.DataFields(1).Value With MainDoc.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True .DataSource.FirstRecord = i .DataSource.LastRecord = i .Execute Pause:=False End With ' Definir o nome do arquivo NomeArquivo = Caminho & "Laudo_nXXX_24_Pantanal_em_Alerta_ID-" & Identificador & ".docx" ' Salvar o documento como .docx Set NovoDoc = ActiveDocument NovoDoc.SaveAs2 fileName:=NomeArquivo, FileFormat:=wdFormatXMLDocument NovoDoc.Close False ' Limpar a referência ao novo documento Set NovoDoc = Nothing Next i ' Limpar a referência ao documento principal Set MainDoc = Nothing MsgBox "Documentos salvos com sucesso!" End Sub

Olá. Eu gostaria de ajuda com um código VBA. Há uns 2 anos atrás encontrei o código abaixo em um fórum na internet. Trata-se de um comando para gerar relatórios a partir de mala direta (um relatório para cada linha da planilha Excel) Eu executava esse código no WORD e ele gerava todos os relatórios a partir do meu modelo. Porém, atualmente está dando o seguinte erro ao executar: [Erro em tempo de Execução '5941': o membro solicitado da coleção não existe] Alguém sabe como corrigir esse erro? ou então conhece algum outro código que atenda ao que eu preciso? Obs: tenho muito pouco conhecimento em programação. HELP-ME Código VBA: Sub Laudos_Queimadas() ' ' Laudos_Queimadas ' ' Application.ScreenUpdating = False Dim qtde As Integer Dim nomeArquivo As String Dim registro As Integer Dim nomearquivouniorg As String ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord qtde = ActiveDocument.MailMerge.DataSource.RecordCount For registro = 1 To qtde nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("A").Value nomearquivouniorg = ActiveDocument.MailMerge.DataSource.DataFields("A").Value 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 FileName:="\\SRV-1383\estagiarios\TAREFAS_SAJ\QUEIMADAS\2024\IDs\LAUDOS\Laudo_nXXX_24_Pantanal_em_Alerta_ID_" & nomearquivouniorg & ".docx", FileFormat:= _ wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _ :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _ :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _ SaveAsAOCELetter:=False, CompatibilityMode:=15 ActiveWindow.Close ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord Next registro Application.ScreenUpdating = True End Sub