在有word檔案的資料夾中新建一個excel工作簿,開啟工作簿,按Alt+F11,把下面的程式碼複製進去,按F5執行。程式碼會複製work檔案的前300個字元到excel中。Sub test() Dim i%, myName$, myPath$, AppWord As Object Set AppWord = CreateObject("Word.Application") myPath = ThisWorkbook.Path & "\" myName = Dir(myPath & "*.doc*") With ActiveSheet .Columns("A:B").ClearContents Do While myName <> "" AppWord.Documents.Open Filename:=myPath & myName i = i + 1 .Cells(i, 1) = myName .Cells(i, 2) = AppWord.ActiveDocument.Range(Start:=0, End:=300).Text AppWord.ActiveDocument.Close False myName = Dir Loop End With AppWord.Quit Set AppWord = Nothing MsgBox "已完成。"End Sub
在有word檔案的資料夾中新建一個excel工作簿,開啟工作簿,按Alt+F11,把下面的程式碼複製進去,按F5執行。程式碼會複製work檔案的前300個字元到excel中。Sub test() Dim i%, myName$, myPath$, AppWord As Object Set AppWord = CreateObject("Word.Application") myPath = ThisWorkbook.Path & "\" myName = Dir(myPath & "*.doc*") With ActiveSheet .Columns("A:B").ClearContents Do While myName <> "" AppWord.Documents.Open Filename:=myPath & myName i = i + 1 .Cells(i, 1) = myName .Cells(i, 2) = AppWord.ActiveDocument.Range(Start:=0, End:=300).Text AppWord.ActiveDocument.Close False myName = Dir Loop End With AppWord.Quit Set AppWord = Nothing MsgBox "已完成。"End Sub