我想從我的 excel 作業簿中的檔案名串列中打開一堆 word 檔案，激活打開的 word 檔案，執行文本替換，并保存更改。我無法在 Excel VBA 和 Word 檔案之間建立聯系。
Dim wdApp As Object, wddoc As Object
'Declare a string variable for Word document
Dim strDocName As String
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
strDocName = xDPathStr \ "FILENAME.docx" '(xDPathStr is the path I have defined earlier with all the word files)'
'Open Word File
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate
wrdApp.Visible = True
uj5u.com熱心網友回復：
從 Excel 中的串列修改 Word 檔案
- 假定檔案名在列中
A。它將打開每個檔案并用另一個字串替換所有出現的字串。 - 這里的重點是如何參考（打開）Word，打開檔案，修改它們（不是那么多），關閉它們并保存更改，最后僅在最初關閉 Word 時才關閉它。
Option Explicit
Sub VisitWord()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Late Binding (not recommended at this stage)
' When you get familiar with how it works, switch to Late Binding:
' Dim wdApp As Object
' Dim WordWasClosed As Boolean
' On Error Resume Next ' see if Word is open
' Set wdApp = GetObject(, Word.Application) ' attempt to create a reference to it
' On Error GoTo 0
' If wdApp Is Nothing Then ' Word is not open
' WordWasClosed = True
' Set wdApp = CreateObject("Word.Application") ' open and create a reference to it
' End If
' wdApp.Visible = True ' default is false; outcomment when done testing
' Dim wdDoc As Object
' ' etc.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Early Binding
' For this to work, in Excel, you need to create a reference to
' Tools > References > Microsoft Word 16.0 Object Library
' Use this to have the Word intellisense work for you.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const WordFolderPath As String = "C:\Test\"
Const FINDSTRING As String = "Old String"
Const REPLACESTRING As String = "New String"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim rg As Range
Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
Dim wdApp As Word.Application
Dim WordWasClosed As Boolean
On Error Resume Next ' see if Word is open
Set wdApp = Word.Application ' attempt to create a reference to it
On Error GoTo 0
If wdApp Is Nothing Then ' Word is not open
WordWasClosed = True
Set wdApp = New Word.Application ' open and create a reference to it
End If
wdApp.Visible = True ' default is false; outcomment when done testing
Dim cell As Range
Dim wdDoc As Word.Document
Dim WordFileName As String
Dim WordFilePath As String
For Each cell In rg.Cells
WordFileName = CStr(cell.Value)
If Len(WordFileName) > 0 Then
WordFilePath = WordFolderPath & WordFileName
If Len(Dir(WordFilePath)) > 0 Then ' file exists
Set wdDoc = wdApp.Documents.Open(WordFilePath)
' Here you do the damage...
wdDoc.Content.Find.Execute _
FindText:=FINDSTRING, _
ReplaceWith:=REPLACESTRING, _
Format:=True, _
Replace:=wdReplaceAll
wdDoc.Close SaveChanges:=True
End If
End If
Next cell
If WordWasClosed Then wdApp.Quit
End Sub
uj5u.com熱心網友回復：
所以這是我到目前為止提出的代碼：
Dim wdApp As Object, wddoc As Object
'Declare a string variable for Word document
Dim strDocName As String
On Error Resume Next
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
strDocName = xDPathStr \ "FILENAME.docx" '(xDPathStr is the path I have defined earlier with all the word files)'
'Open Word File
wdApp.Activate
Set wddoc = wdApp.Documents(strDocName)
If wddoc Is Nothing Then Set wddoc = wdApp.Documents.Open(strDocName)
wddoc.Activate
wrdApp.Visible = True
uj5u.com熱心網友回復：
這是我最近創建的一些示例代碼，用于遍歷 Excel 中的單元格，這些單元格是 Word 檔案的路徑。打開每個 Word 檔案，掃描表格（在 Word 中），然后復制/粘貼到 Excel。看看你能不能從這個開始。如果您有其他問題，請回復。
Sub LoopThroughAllWordFiles()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim oTbl As Word.Table
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet
Dim cnt As Long
Dim tableCount As Long
Dim lrow As Long
Dim lastrow As Long
Dim file As String
Dim rng As Range, cell As Range
Dim objDoc As Object
Dim objWord As Object
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Set rng = Worksheets("Files").Range("A1:A200")
Worksheets("Word_Tables").Select
filecounter = 1
cnt = 1
Set objWord = CreateObject("Word.Application")
obj.Word.Visible = False
For Each cell In rng.SpecialCells(xlCellTypeVisible)
MyStr = Right(cell, 5)
If MyStr = ".docx" Then
mylength = Len(cell)
pos = InStrRev(cell, "\")
strFolder = Left(cell, pos)
strFile = Right(cell, mylength - pos)
Worksheets("Word_Files").Select
Set objWord = wdApp.Documents.Open(Filename:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
Set sht = ThisWorkbook.Worksheets("Word_Files")
lastrow = Worksheets("Word_Files").UsedRange.Rows.Count 1
totTbl = objDoc.Tables.Count
Debug.Print totTbl
For Each oTbl In objDoc.Tables
strCellText = oTbl.cell(1, 1).Range.Text
strCellText = LCase(strCellText)
Debug.Print strCellText
If strCellText Like "*data input*" Then
Worksheets("Word_Files").Range("A" & lastrow) = strFolder & strFile
On Error Resume Next
If cnt = 1 Then
lastrow = lastrow
Else
lastrow = ActiveSheet.UsedRange.Rows.Count
End If
oTbl.Range.Copy
Range("B" & lastrow).Select
sht.Paste
cnt = cnt 1
End If
Next oTbl
End If
filecounter = filecounter 1
Debug.Print filecounter
objWord.Close
Next cell
objDoc.Quit
Set objDoc = Nothing
objWord.Quit
Set objWord = Nothing
SecondsElapsed = Round(Timer - StartTime, 2)
SecondsFinal = SecondsElapsed / 60
MsgBox ("Code ran in " & SecondsFinal & "minutes.")
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/448520.html