vbs如何doc文档文件转化成xls表格文件

hnldwhm52

请教老师?
    怎样用vbs将1.doc中表格转成2.xls 如下图：

600388        西南药业        环保问题上升至国家层面股价上攻       
002105        龙净环保        体育总局调研        概念股大涨
601226        信隆实业        兼备“一带一路”华电重工再飙升       
300368        华电重工        受益互联网金融发展       
000938        汇金股份        工业4.0重磅盛会将召开       
600026        紫光股份        受益于油价下跌及运价上涨       
601872        中海发展        低油价+运价上涨        招商轮船受益

                先谢啦！！！！

谢谢 DAIC老师 快速回复附件如下：

DAIC

把你的1.doc压缩之后传上来看看

apang

1. sPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,""))
   
2. 
   
3. Set objWord=CreateObject("Word.Application")
   
4. objWord.Visible = True
   
5. Set objDoc = objWord.Documents.Open(sPath & "1.DOC")
   
6. objDoc.Tables(1).Range.Copy
   
7. objDoc.Close
   
8. objWord.Quit
   
9. 
   
10. Set objExcel = CreateObject("Excel.Application")
    
11. objExcel.Visible = True
    
12. objExcel.WorkBooks.Add
    
13. objExcel.WorkSheets(1).Activate
    
14. objExcel.ActiveSheet.Paste
    
15. objExcel.ActiveWorkBook.SaveAs(sPath & "hello.xlsx")
    
16. objExcel.WorkBooks.Close
    
17. objExcel.Quit

复制代码

hnldwhm52

apang 发表于 2014-12-19 19:01

首先感谢apang 老师的解答！但未成功（我用的是 Office2003 ），提示如下图：
   
请您再费心解答！！

apang

1. sPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,""))
   
2. 
   
3. Set objWord=CreateObject("Word.Application")
   
4. objWord.Visible = True
   
5. Set objDoc = objWord.Documents.Open(sPath & "1.DOC")
   
6. row = objDoc.Tables(1).Rows.Count
   
7. column = objDoc.Tables(1).Columns.Count
   
8. 
   
9. Set objExcel = CreateObject("Excel.Application")
   
10. objExcel.Visible = True
    
11. objExcel.WorkBooks.Add
    
12. objExcel.WorkSheets(1).Activate
    
13. 
    
14. For i = 1 to row
    
15.         For j = 1 to column
    
16.                 s = objDoc.Tables(1).Cell(i, j).Range.Text
    
17.                 objExcel.ActiveSheet.Cells(i, j) = Left(s, Len(s)-1)
    
18.         Next
    
19. Next
    
20. 
    
21. objDoc.Close
    
22. objWord.Quit
    
23. objExcel.ActiveWorkBook.SaveAs sPath & "hello.xls"
    
24. objExcel.WorkBooks.Close
    
25. objExcel.Quit

复制代码