試試下面的程式碼:
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% "定義找到的欄位的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy "選中找到的兩個欄位中間的內容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
試試下面的程式碼:
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% "定義找到的欄位的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
Set wdRng = mydoc.Range
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy "選中找到的兩個欄位中間的內容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub