|
代码中添加几句doevents,就不会假死了,而且在状态栏中会显示当前正在导入的文件
- Sub 汇总()
- Set d = CreateObject("scripting.dictionary")
- myPath = ThisWorkbook.Path & ""
- Set wdApp = CreateObject("word.application")
- wdApp.Visible = False
- Set sh = ThisWorkbook.Worksheets(1)
- sh.Cells.ClearContents
- Filename = Dir(myPath & "*.doc*")
- Do While Filename <> ""
- Set wdD = wdApp.Documents.Open(myPath & Filename)
- Application.StatusBar = "正在导入:" & myPath & Filename
- For i = 1 To wdD.Paragraphs.Count
- mystr = mystr & wdD.Paragraphs(i).Range.Text & Chr(10)
- DoEvents
- Next
- r = sh.Cells(Rows.Count, 1).End(3).Row + 1
- sh.Cells(r, 1) = Left(Filename, InStrRev(Filename, ".") - 1)
- sh.Cells(r, 2) = mystr
- mystr = ""
- wdD.Close
- Filename = Dir
- DoEvents
- Loop
- wdApp.Quit
- Set wdD = Nothing
- Set wdApp = Nothing
- Application.StatusBar = "导入完毕!"
- End Sub
复制代码 |
|