首页 > 解决方案 > 交替运行时未设置 Word 宏对象变量或块变量

问题描述

我编写了一个宏,它可以从 word 文件中获取某些字段的值并将其插入到 excel 文件中。在每次交替运行时,单词宏都会给出错误“对象变量或未设置块变量”。请帮我。

Sub getWordFormData()
    Dim exApp As Object, myDoc As Object
    Dim myFolder As String, strFile As String
    Dim excelApp As Object
  Dim openExcel As Workbook

     myFolder = ActiveDocument.Path
        If Len((myFolder)) = 0 Then
        MsgBox myFolder & vbCrLf & "Not Found", vbInformation, "Cancelled - getWordFormData"
        End If
    Application.ScreenUpdating = False
    Set exApp = CreateObject("Word.Application")
Set myDoc = ActiveWorkbook
   Set excelApp = New Excel.Application
  Set openExcel = excelApp.Workbooks.Open("F:\VBA Sample projects\word to excel\Proposal_DB.xlsx")
  excelApp.Visible = True
excelApp.Range("A1").End(xlDown).Offset(1, 0).Select
   Set myDoc = exApp.Documents.Open(FileName:=myFolder & "\" & "TEMPLATE WORD.docx", ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
            With excelApp
             .Cells(ActiveCell.Row, 1).Value = myDoc.SelectContentControlsByTag("date").Item(1).Range.Text
            .Cells(ActiveCell.Row, 2).Value = myDoc.SelectContentControlsByTag("ProtocolNo.").Item(1).Range.Text
            .Cells(ActiveCell.Row, 3).Value = myDoc.SelectContentControlsByTag("Subject").Item(1).Range.Text
            'excelApp.Cells(ActiveCell.Row, 4).Value = myDoc.SelectContentControlsByTag("companyname").Item(1).Range.Text
            'excelApp.Cells(ActiveCell.Row, 5).Value = myDoc.SelectContentControlsByTag("customer_name").Item(1).Range.Text
            'excelApp.Cells(Nextrow.Row, 6).Value = myDoc.SelectContentControlsByTag("total_amount").Item(1).Range.Text
            'excelApp.Cells(Nextrow.Row, 7).Value = myDoc.SelectContentControlsByTag("employee_name").Item(1).Range.Text
End With
            myDoc.Close SaveChanges:=False
           ' strFile = Dir()
        'Wend
        excelApp.Quit

        Application.ScreenUpdating = True
    'End With
'exApp.Quit
End Sub

在此处输入图像描述

标签: excelvbams-word

解决方案


已编译但未测试:

'add a reference to the Microsoft Excel objectl ibary in your VBA project
Sub getWordFormData()

    Dim myDoc As Document
    Dim myFolder As String, strFile As String
    Dim excelApp As Excel.Application
    Dim excelWb As Excel.Workbook, rw As Excel.Range

    myFolder = ActiveDocument.Path
    If Len(myFolder) = 0 Then
        MsgBox myFolder & vbCrLf & " Not Found", vbInformation, "Cancelled - getWordFormData"
        Exit Sub
    End If

    'create Excel application and open the workbook
    Set excelApp = New Excel.Application
    excelApp.Visible = True
    Set excelWb = excelApp.Workbooks.Open("F:\VBA Sample projects\word to excel\Proposal_DB.xlsx")

    'get the next empty row in the worksheet
    With excelWb.Sheets(1) '<< or use a specific sheet name
        Set rw = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
    End With

    'you don't need a separate Word instance to open this document...
    Set myDoc = Documents.Open(FileName:=myFolder & "\" & "TEMPLATE WORD.docx", _
                       ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
    rw.Cells(1).Value = myDoc.SelectContentControlsByTag("date").Item(1).Range.Text
    rw.Cells(2).Value = myDoc.SelectContentControlsByTag("ProtocolNo.").Item(1).Range.Text
    rw.Cells(3).Value = myDoc.SelectContentControlsByTag("Subject").Item(1).Range.Text

    myDoc.Close savechanges:=False

    excelWb.Close savechanges:=True

    excelApp.Quit

End Sub

推荐阅读