excel - 交替运行时未设置 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
解决方案
已编译但未测试:
'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
推荐阅读
- python - GCP 云功能未正确接收/确认 PubSub 消息
- amazon-web-services - 如何在 CloudFormation 中获取手动创建的 dynamodb 表的 streamArn
- python - pygame中大小不同的精灵的碰撞
- javascript - 如何正确阻止 Node.JS 服务器应用程序中的 IP 地址?
- python - 基于多列的 UTC 到 PDT/CDT/EDT 熊猫
- python - 搜索相应对象的最有效方法?
- c++ - 交换二维数组中的列c ++
- javascript - 如何重置 react-virtualized 包中的 Infinite Loader?
- google-chrome-extension - content_scripts 无法在某个特定网站上加载 Url
- python - 如何简化这个 python 正则表达式代码?