需要宏将Word数据传输到Excel

需要宏将Word数据传输到Excel

我对 VBA 还很陌生,需要帮助!我在 Excel 中有一个 VB 宏,它可以从 Word 文档中获取数据并将其导入 Excel 工作表。目前,宏中的代码具有清除活动工作表并放置新记录的表达式。但是,我只需要用新记录更新活动工作表,或者添加新记录。因此,试图弄清楚如何在现有代码中完成它。

这是宏:

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

答案1

它应该通过删除行来工作ActiveSheet.Cells.Clear,因为这是删除单元格内容的行。

该行i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row用于了解最后一行的内容,以便从那里写入新内容。因此,只要最后一行的第一列有内容,它就会起作用。

为了避免反复读取相同的文件,需要将已经导出的文件移动到另一个文件夹。我的想法是这样的:

  1. 创建一个文件夹,例如:C:\Users\zsirotilo\Documents\Retention DB\Exported

  2. exportedFolder = "C:\Users\zsirotilo\Documents\Retention DB\Exported"在定义变量的行后添加该行myFolder

  3. 在该行后面myDoc.Close SaveChanges:=False添加以下几行:

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

在测试之前备份 Word 文件, C:\Users\zsirotilo\Documents\Retention DB\Interviews因为它将删除文件。

相关内容