[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[已解决]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 编辑 ]
技术问题请到论坛发帖求助!

回复 7楼 的帖子

测试ok,感谢!
技术问题请到论坛发帖求助!

TOP

新代码略作修正如下:
  1. on error Resume next
  2. '/*/////////////////////配置信息////////////////////////////////////
  3. FontSize=16                        '字体大小
  4. FontName="黑体"                        '字体名称
  5. Bold=True                        '是否粗体:是则为True,否为false
  6. TextColumnNum=1                        'Word页面栏数
  7. LineSpacing = 21                '行距固定值
  8. TopMargin =2                        '上边距
  9. BottomMargin =2                        '下边距
  10. LeftMargin =2                        '左边距
  11. RightMargin =2                        '右边距
  12. isHeader=false   '是否设置页眉,是为True,否为false
  13. '/*////////////////////////////////////////////////////////////////
  14. msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
  15. msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
  16. msg=msg & vbcrlf & vbcrlf & "开始处理?"
  17. CH=msgbox(msg,vbokcancel,"Txt2Word")
  18. if CH<>1 then wscript.quit
  19. Const ForReading = 1, ForWriting = 2
  20. Set FSO = CreateObject("Scripting.FileSystemObject")
  21. set FF=FSO.getfolder(".")
  22. set FC=FF.files
  23. set WordApp=CreateObject("word.application")
  24. WordApp.visible=Visible
  25. WordApp.Documents.Add
  26. set MyWord=WordApp.Activedocument
  27. MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1                '页脚居中对齐
  28. Myword.Sections(1).Headers(1).Range.ParagraphFormat.Alignment = 1 '页眉居中对齐
  29. '/*////////////////////对word格式进行设置////////////////////
  30. With MyWord.Content.Font
  31.         .Size = FontSize
  32.         .Name = FontName
  33.         .Bold = Bold
  34. End With
  35. With MyWord.PageSetup
  36.         .TopMargin =TopMargin * 28.35
  37.         .BottomMargin =BottomMargin * 28.35
  38.         .LeftMargin =LeftMargin * 28.35
  39.         .RightMargin =RightMargin * 28.35
  40. End With
  41. MyWord.PageSetup.TextColumns.SetCount TextColumnNum
  42. With MyWord.Content.ParagraphFormat
  43.         .LineSpacingRule = 4
  44.         .LineSpacing = LineSpacing
  45. End With
  46. '/*//////////////////////////////////////////////////////////
  47. FolderPath=FF.path
  48. For each fl in FC
  49.         ext=Lcase(fso.GetExtensionName(fl))
  50.         if ext="txt" then
  51.                 Set f = fso.OpenTextFile(fl, ForReading)  
  52.   FirstLine=f.ReadLine
  53.   if isHeader=True then
  54.    Myword.Sections(1).Headers(1).Range.text=FirstLine
  55.   else
  56.    WordApp.ActiveWindow.ActivePane.View.SeekView =9
  57.        WordApp.ActiveWindow.ActivePane.View.SeekView =0
  58.   end if
  59.                 FileContent=FirstLine & vbcrlf & f.readall
  60.                 FileName=split(fl.name,".")
  61.                 f.close
  62.                 MyWord.Content.text=FileContent
  63.                
  64.                 MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
  65.                 wscript.sleep 1000
  66.         end if
  67. Next
  68. WordApp.quit(0)
  69. msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
  70. set FC=nothing
  71. set FF=nothing
  72. Set FSO=nothing
复制代码

TOP

回复 3楼 的帖子

能否在“配置信息”中再增加两个功能?
1、自动添加页眉,内容是txt文件的第一行
2、删除页眉。
技术问题请到论坛发帖求助!

TOP

打开 一个word文档,货excel文档
工具--宏--【visual basic 编辑器】
然后出了一个新界面~  在新界面中选   【视图】-【对象浏览器】

里面有很多对象和方法,也可以根据已知的对象,搜索看看还有其他什么方法。

[ 本帖最后由 523066680 于 2009-9-30 18:54 编辑 ]

TOP

回复 3楼 的帖子

非常感谢,圆满完成!
技术问题请到论坛发帖求助!

TOP

在上面代码的基础上添加了一些格式设置(按自己要求修改其中的配置信息)
  1. on error Resume next
  2. '/*/////////////////////配置信息////////////////////////////////////
  3. FontSize=16                        '字体大小
  4. FontName="黑体"                        '字体名称
  5. Bold=True                        '是否粗体:是则为True,否为false
  6. TextColumnNum=1                        'Word页面栏数
  7. LineSpacing = 21                '行距固定值
  8. TopMargin =2                        '上边距
  9. BottomMargin =2                        '下边距
  10. LeftMargin =2                        '左边距
  11. RightMargin =2                        '右边距
  12. '/*////////////////////////////////////////////////////////////////
  13. msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
  14. msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
  15. msg=msg & vbcrlf & vbcrlf & "开始处理?"
  16. CH=msgbox(msg,vbokcancel,"Txt2Word")
  17. if CH<>1 then wscript.quit
  18. Const ForReading = 1, ForWriting = 2
  19. Set FSO = CreateObject("Scripting.FileSystemObject")
  20. set FF=FSO.getfolder(".")
  21. set FC=FF.files
  22. set WordApp=CreateObject("word.application")
  23. WordApp.visible=Visible
  24. WordApp.Documents.Add
  25. set MyWord=WordApp.Activedocument
  26. MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1                '页脚居中对齐
  27. '/*////////////////////对word格式进行设置////////////////////
  28. With MyWord.Content.Font
  29.         .Size = FontSize
  30.         .Name = FontName
  31.         .Bold = Bold
  32. End With
  33. With MyWord.PageSetup
  34.         .TopMargin =TopMargin * 28.35
  35.         .BottomMargin =BottomMargin * 28.35
  36.         .LeftMargin =LeftMargin * 28.35
  37.         .RightMargin =RightMargin * 28.35
  38. End With
  39. MyWord.PageSetup.TextColumns.SetCount TextColumnNum
  40. With MyWord.Content.ParagraphFormat
  41.         .LineSpacingRule = 4
  42.         .LineSpacing = LineSpacing
  43. End With
  44. '/*//////////////////////////////////////////////////////////
  45. FolderPath=FF.path
  46. For each fl in FC
  47.         ext=Lcase(fso.GetExtensionName(fl))
  48.         if ext="txt" then
  49.                 Set f = fso.OpenTextFile(fl, ForReading)
  50.                 FileContent=f.readall
  51.                 FileName=split(fl.name,".")
  52.                 f.close
  53.                 MyWord.Content.text=FileContent
  54.                
  55.                 MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
  56.                 wscript.sleep 1000
  57.         end if
  58. Next
  59. WordApp.quit(0)
  60. msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
  61. set FC=nothing
  62. set FF=nothing
  63. Set FSO=nothing
复制代码
1

评分人数

    • 随风: 太好了!PB + 11 技术 + 1 + 1

TOP

测试代码(使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可):
  1. msg="注意:程序运行期间,请不要操作word!" & vbcrlf & vbcrlf
  2. msg=msg & "使用方法:将本程序拷贝到待处理txt文件所在目录,运行即可!"
  3. msg=msg & vbcrlf & vbcrlf & "开始处理?"
  4. CH=msgbox(msg,vbokcancel,"Txt2Word")
  5. if CH<>1 then wscript.quit
  6. on error Resume next
  7. Const ForReading = 1, ForWriting = 2
  8. Set FSO = CreateObject("Scripting.FileSystemObject")
  9. set FF=FSO.getfolder(".")
  10. set FC=FF.files
  11. set WordApp=CreateObject("word.application")
  12. WordApp.visible=Visible
  13. WordApp.Documents.Add
  14. set MyWord=WordApp.Activedocument
  15. FolderPath=FF.path
  16. For each fl in FC
  17. ext=Lcase(fso.GetExtensionName(fl))
  18. if ext="txt" then
  19. Set f = fso.OpenTextFile(fl, ForReading)
  20. FileContent=f.readall
  21. FileName=split(fl.name,".")
  22. f.close
  23. MyWord.Content.text=FileContent
  24. MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"
  25. wscript.sleep 1000
  26. end if
  27. Next
  28. WordApp.quit(0)
  29. msgbox "恭喜你,转换完成!",vbokonly+vbinformation,"Txt2Doc"
  30. set FC=nothing
  31. set FF=nothing
  32. Set FSO=nothing
复制代码
1

评分人数

TOP

返回列表