Necessita de macro para transferir dados do Word para o Excel

Question

Eu sou muito novo no VBA e preciso de ajuda! Eu tenho macro VB no Excel que agarra os dados de um documento do Word e os importa para a planilha do Excel. Atualmente, o código na macro possui uma expressão que limpa a planilha ativa e coloca os novos registros. No entanto, só preciso atualizar a planilha ativa com novos registros ou adicionar novos registros. Então, tentando descobrir como realizá-lo dentro do código existente.

Aqui está a macro:

Sub getWordFormData()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim CCtl As Word.ContentControl
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long

myFolder = "C:\Users\zsirotilo\Documents\Retention DB\Interviews"
Application.ScreenUpdating = False

If myFolder = "" Then Exit Sub
Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear

Range("A1") = "Company Name"
Range("A1").Font.Bold = True
Range("C1") = "Date of Interview"
Range("C1").Font.Bold = True
Range("D1") = "Type of Company by Number(see Case Notes)"
Range("D1").Font.Bold = True

i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.docx", vbNormal)

While strFile <> ""
i = i + 1

Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile,
AddToRecentFiles:=False, Visible:=False)

With myDoc
j = 0
For Each CCtl In .ContentControls
j = j + 1
myWkSht.Cells(i, j) = CCtl.Range.Text
Next
myWkSht.Columns.ColumnWidth = 25
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
Application.ScreenUpdating = True

End Sub

    

Answer 1

Deve funcionar removendo a linha ActiveSheet.Cells.Clear , porque esta é a linha que remove o conteúdo das células.

A linha i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row é usada para saber a última linha com conteúdo para gravar o novo conteúdo a partir de então. Por isso, funcionará desde que a última linha tenha conteúdo na primeira coluna.

Para evitar a leitura repetida dos mesmos arquivos, é necessário mover os arquivos já exportados para outra pasta. Minha ideia é esta:

1. Crie uma pasta, por exemplo: C:\Users\zsirotilo\Documents\Retention DB\Exported .

2. Adicione a linha exportedFolder = "C:\Users\zsirotilo\Documents\Retention DB\Exported" após a linha que define a variável myFolder .

3. Após a linha myDoc.Close SaveChanges:=False , adicione as seguintes linhas:

       FileCopy myDoc, exportedFolder & "\" & strFile 'copy word file to Exported folder
       Kill myDoc 'deletes the word file
   

Faça um backup dos arquivos do Word em C:\Users\zsirotilo\Documents\Retention DB\Interviews antes do teste, pois ele os arquivos.