用于打开多个word表单并将数据导入Excel的VBA代码

Sub ImportDataFromWordToExcel()
    Dim wdApp As Object ' Word Application
    Dim wdDoc As Object ' Word Document
    Dim xlApp As Object ' Excel Application
    Dim xlWorkbook As Object ' Excel Workbook
    Dim xlWorksheet As Object ' Excel Worksheet
    Dim i As Integer ' Counter for worksheets
    
    ' Create instances of Word and Excel applications
    Set wdApp = CreateObject("Word.Application")
    Set xlApp = CreateObject("Excel.Application")
    
    ' Open each Word document and import data into Excel
    For i = 1 To 3 ' Assuming you have 3 Word documents to import
        ' Open Word document
        Set wdDoc = wdApp.Documents.Open("C:\Path\To\WordDocument" & i & ".docx")
        
        ' Activate Excel application
        xlApp.Visible = True
        
        ' Create a new workbook or open an existing one
        If i = 1 Then
            Set xlWorkbook = xlApp.Workbooks.Add
        Else
            Set xlWorkbook = xlApp.Workbooks.Open("C:\Path\To\ExcelWorkbook.xlsx")
        End If
        
        ' Set the worksheet to import data into
        Set xlWorksheet = xlWorkbook.Worksheets(i)
        
        ' Copy data from Word document to Excel worksheet
        wdDoc.Content.Copy
        xlWorksheet.Range("A1").PasteSpecial
        
        ' Save and close Excel workbook
        xlWorkbook.SaveAs "C:\Path\To\ExcelWorkbook.xlsx"
        xlWorkbook.Close
        
        ' Close Word document
        wdDoc.Close
    Next i
    
    ' Quit Word and Excel applications
    wdApp.Quit
    xlApp.Quit
    
    ' Release object references
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub