我已經在 Excel 中有一個宏，它從指定的 Word 檔案中的特定表、行和列中提取資料，并將其回傳到我的 Excel s/sheet 中的單元格。我需要對代碼進行 2 處更改，但我的知識還不夠先進。
我需要在指定檔案夾中的多個 Word 檔案上運行此代碼，無論是 .doc 還是 .docx
我需要確定為什么在某些 Word 檔案中，代碼無法從 Word 檔案中提取資料，并且我得到 RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'。我嘗試在模塊的開頭放置'on error resume next'，以便它繼續運行到最后，希望某些文本能夠通過，但我的 Excel s/sheet 中的單元格仍然沒有人口稠密。
Sub ImportFromWord()
On Error Resume Next
'Activate Word Object Library
Dim WordDoc As Word.Document
Set WordApp = CreateObject("word.application") ' Open Word session
WordApp.Visible = False 'keep word invisible
Set WordDoc = WordApp.Documents.Open("C:\Users\brendan.ramsey\OneDrive - Ofcom\Objectives\Brendan's Objectives 2022-23\Licence calls\test 2.docx") ' open Word file
'copy third row of first Word table
WordDoc.Tables(1).Cell(Row:=1, Column:=3).Range.Copy
'paste in Excel
Range("A3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=6).Range.Copy
Range("B3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=3).Range.Copy
Range("C3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=5).Range.Copy
Range("D3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=7).Range.Copy
Range("E3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=2).Range.Copy
Range("F3").PasteSpecial xlPasteValues
WordDoc.Close 'close Word doc
WordApp.Quit ' close Word
End Sub
uj5u.com熱心網友回復：
如果您避免所有復制/粘貼并直接傳輸單元格內容，您的代碼可能會表現得更好：
Sub ImportFromWord()
Const FLDR_PATH As String = "C:\Temp\Docs\"
Dim WordDoc As Word.Document, WordApp As Word.Application
Dim rw As Range, f
Set rw = ActiveSheet.Rows(3) 'or some other sheet
f = Dir(FLDR_PATH & "*.doc*") 'check for document
Do While Len(f) > 0
If WordApp Is Nothing Then 'open word if not already open
Set WordApp = CreateObject("word.application")
WordApp.Visible = False
End If
With WordApp.Documents.Open(FLDR_PATH & f, ReadOnly:=True) ' open Word file
WordCellToExcel .Tables(1).Cell(Row:=1, Column:=3), rw.Cells(1)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=6), rw.Cells(2)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=3), rw.Cells(3)
'etc etc
.Close savechanges:=False
End With
Set rw = rw.Offset(1) 'next row down
f = Dir() 'next file, if any
Loop
If Not WordApp Is Nothing Then WordApp.Quit ' close Word if it was opened
End Sub
'transfer content from a cell in a Word Table to an Excel range
Sub WordCellToExcel(wdCell As Word.Cell, destCell As Range)
Dim v
v = wdCell.Range.Text
destCell.Value = Left(v, Len(v) - 2) 'remove "end of cell" marker
End Sub
uj5u.com熱心網友回復：
運行時錯誤代碼“4605”“方法或屬性不可用，因為沒有選擇文本”。
運行時代碼 4605 在 Microsoft Word 在運行時出現故障或崩潰時發生。這并不一定意味著代碼以某種方式損壞，而只是它在運行時不起作用。除非處理和糾正，否則此類錯誤將在您的螢屏上顯示為煩人的通知。以下是解決問題的癥狀、原因和方法。
正如錯誤訊息所說，沒有選擇文本。要找出哪個屬性或方法給出了錯誤訊息，我建議通過在單獨的行上宣告每個屬性或方法呼叫來打破單行代碼中的呼叫鏈，這樣您就會知道哪個呼叫準確地失敗了。
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/529613.html