[问题求助] vbs如何doc文档文件转化成xls表格文件

hnldwhm52

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

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

                先谢啦！！！！

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

apang

sPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))

Set objWord=CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(sPath & "1.DOC")
row = objDoc.Tables(1).Rows.Count
column = objDoc.Tables(1).Columns.Count

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.WorkBooks.Add
objExcel.WorkSheets(1).Activate

For i = 1 to row
        For j = 1 to column
                s = objDoc.Tables(1).Cell(i, j).Range.Text
                objExcel.ActiveSheet.Cells(i, j) = Left(s, Len(s)-1)
        Next
Next

objDoc.Close
objWord.Quit
objExcel.ActiveWorkBook.SaveAs sPath & "hello.xls"
objExcel.WorkBooks.Close
objExcel.Quit
复制代码

hnldwhm52

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

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

apang

sPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\"))

Set objWord=CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(sPath & "1.DOC")
objDoc.Tables(1).Range.Copy
objDoc.Close
objWord.Quit

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.WorkBooks.Add
objExcel.WorkSheets(1).Activate
objExcel.ActiveSheet.Paste
objExcel.ActiveWorkBook.SaveAs(sPath & "hello.xlsx")
objExcel.WorkBooks.Close
objExcel.Quit
复制代码

DAIC

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