标题: [已解决]VBS批量把txt转换成doc [打印本页]
作者: 随风 时间: 2009-9-30 02:43 标题: [已解决]VBS批量把txt转换成doc
求助:vbs批量转换txt为doc
之前曾发过一帖求助是将单个txt文件转换成doc
现在想批量转换,因为发现频繁运行vbs也会影响效率
具体要求如下:
我是在bat批处理中运行vbs文件,如:call a.vbs
现需要这样的功能
call a.vbs "c:\ab cd" "排版"
意思是运行上面的代码,则将 c:\ab cd 文件夹里的所有txt文件转换成doc,并运行word中名称为 排版 的宏。
如果是 call a.vbs "c:\ab cd" 则不需要运行宏。
需考虑文件夹或文件名含空格的情况,不需处理子文件夹里的文件。
.
另:上次求助得到了两个将txt转为doc的代码,
一个是打开word将txt内容写入word,
另一个是打开word将txt内容复制到word
发现使用第一个代码有时会出现乱码,所以最好是采取打开word将txt内容复制到word的方式。
谢谢!
[ 本帖最后由 随风 于 2009-10-2 15:09 编辑 ]
作者: youxi01 时间: 2009-9-30 09:39
测试代码(使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可):- msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
- msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
-
- msg=msg & vbcrlf & vbcrlf & "开始处理?"
- CH=msgbox(msg,vbokcancel,"Txt2Word")
- if CH<>1 then wscript.quit
-
- on error Resume next
- Const ForReading = 1, ForWriting = 2
- Set FSO = CreateObject("Scripting.FileSystemObject")
- set FF=FSO.getfolder(".")
- set FC=FF.files
-
- set WordApp=CreateObject("word.application")
- WordApp.visible=Visible
- WordApp.Documents.Add
- set MyWord=WordApp.Activedocument
-
- FolderPath=FF.path
- For each fl in FC
- ext=Lcase(fso.GetExtensionName(fl))
- if ext="txt" then
- Set f = fso.OpenTextFile(fl, ForReading)
- FileContent=f.readall
- FileName=split(fl.name,".")
- f.close
- MyWord.Content.text=FileContent
-
- MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
- wscript.sleep 1000
- end if
- Next
- WordApp.quit(0)
-
- msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
- set FC=nothing
- set FF=nothing
- Set FSO=nothing
复制代码
作者: youxi01 时间: 2009-9-30 12:00
在上面代码的基础上添加了一些格式设置(按自己要求修改其中的配置信息)- on error Resume next
-
- '/*/////////////////////配置信息////////////////////////////////////
- FontSize=16 '字体大小
- FontName="黑体" '字体名称
- Bold=True '是否粗体:是则为True,否为false
- TextColumnNum=1 'Word页面栏数
- LineSpacing = 21 '行距固定值
-
- TopMargin =2 '上边距
- BottomMargin =2 '下边距
- LeftMargin =2 '左边距
- RightMargin =2 '右边距
- '/*////////////////////////////////////////////////////////////////
-
- msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
- msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
-
- msg=msg & vbcrlf & vbcrlf & "开始处理?"
- CH=msgbox(msg,vbokcancel,"Txt2Word")
- if CH<>1 then wscript.quit
-
- Const ForReading = 1, ForWriting = 2
- Set FSO = CreateObject("Scripting.FileSystemObject")
- set FF=FSO.getfolder(".")
- set FC=FF.files
-
- set WordApp=CreateObject("word.application")
- WordApp.visible=Visible
- WordApp.Documents.Add
- set MyWord=WordApp.Activedocument
- MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1 '页脚居中对齐
-
- '/*////////////////////对word格式进行设置////////////////////
- With MyWord.Content.Font
- .Size = FontSize
- .Name = FontName
- .Bold = Bold
- End With
-
- With MyWord.PageSetup
- .TopMargin =TopMargin * 28.35
- .BottomMargin =BottomMargin * 28.35
- .LeftMargin =LeftMargin * 28.35
- .RightMargin =RightMargin * 28.35
- End With
-
- MyWord.PageSetup.TextColumns.SetCount TextColumnNum
-
- With MyWord.Content.ParagraphFormat
- .LineSpacingRule = 4
- .LineSpacing = LineSpacing
- End With
- '/*//////////////////////////////////////////////////////////
-
- FolderPath=FF.path
- For each fl in FC
- ext=Lcase(fso.GetExtensionName(fl))
- if ext="txt" then
- Set f = fso.OpenTextFile(fl, ForReading)
- FileContent=f.readall
- FileName=split(fl.name,".")
- f.close
- MyWord.Content.text=FileContent
-
- MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
- wscript.sleep 1000
- end if
- Next
- WordApp.quit(0)
-
- msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
- set FC=nothing
- set FF=nothing
- Set FSO=nothing
复制代码
作者: 随风 时间: 2009-9-30 13:20 标题: 回复 3楼 的帖子
非常感谢,圆满完成!
作者: 523066680 时间: 2009-9-30 17:39
打开 一个word文档,货excel文档
工具--宏--【visual basic 编辑器】
然后出了一个新界面~ 在新界面中选 【视图】-【对象浏览器】
里面有很多对象和方法,也可以根据已知的对象,搜索看看还有其他什么方法。
[ 本帖最后由 523066680 于 2009-9-30 18:54 编辑 ]
作者: 随风 时间: 2009-10-2 08:13 标题: 回复 3楼 的帖子
能否在“配置信息”中再增加两个功能?
1、自动添加页眉,内容是txt文件的第一行
2、删除页眉。
作者: youxi01 时间: 2009-10-2 10:40
新代码略作修正如下:-
- on error Resume next
- '/*/////////////////////配置信息////////////////////////////////////
- FontSize=16 '字体大小
- FontName="黑体" '字体名称
- Bold=True '是否粗体:是则为True,否为false
- TextColumnNum=1 'Word页面栏数
- LineSpacing = 21 '行距固定值
- TopMargin =2 '上边距
- BottomMargin =2 '下边距
- LeftMargin =2 '左边距
- RightMargin =2 '右边距
- isHeader=false '是否设置页眉,是为True,否为false
- '/*////////////////////////////////////////////////////////////////
- msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
- msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
- msg=msg & vbcrlf & vbcrlf & "开始处理?"
- CH=msgbox(msg,vbokcancel,"Txt2Word")
- if CH<>1 then wscript.quit
- Const ForReading = 1, ForWriting = 2
- Set FSO = CreateObject("Scripting.FileSystemObject")
- set FF=FSO.getfolder(".")
- set FC=FF.files
- set WordApp=CreateObject("word.application")
- WordApp.visible=Visible
- WordApp.Documents.Add
- set MyWord=WordApp.Activedocument
- MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1 '页脚居中对齐
- Myword.Sections(1).Headers(1).Range.ParagraphFormat.Alignment = 1 '页眉居中对齐
- '/*////////////////////对word格式进行设置////////////////////
- With MyWord.Content.Font
- .Size = FontSize
- .Name = FontName
- .Bold = Bold
- End With
- With MyWord.PageSetup
- .TopMargin =TopMargin * 28.35
- .BottomMargin =BottomMargin * 28.35
- .LeftMargin =LeftMargin * 28.35
- .RightMargin =RightMargin * 28.35
- End With
- MyWord.PageSetup.TextColumns.SetCount TextColumnNum
- With MyWord.Content.ParagraphFormat
- .LineSpacingRule = 4
- .LineSpacing = LineSpacing
- End With
- '/*//////////////////////////////////////////////////////////
- FolderPath=FF.path
- For each fl in FC
- ext=Lcase(fso.GetExtensionName(fl))
- if ext="txt" then
- Set f = fso.OpenTextFile(fl, ForReading)
- FirstLine=f.ReadLine
- if isHeader=True then
- Myword.Sections(1).Headers(1).Range.text=FirstLine
- else
- WordApp.ActiveWindow.ActivePane.View.SeekView =9
- WordApp.ActiveWindow.ActivePane.View.SeekView =0
- end if
- FileContent=FirstLine & vbcrlf & f.readall
- FileName=split(fl.name,".")
- f.close
- MyWord.Content.text=FileContent
-
- MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
- wscript.sleep 1000
- end if
- Next
- WordApp.quit(0)
- msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
- set FC=nothing
- set FF=nothing
- Set FSO=nothing
复制代码
作者: 随风 时间: 2009-10-2 15:08 标题: 回复 7楼 的帖子
测试ok,感谢!
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |