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

Rank: 8Rank: 8

帖子
1759 
积分
5387 
技术
51  
捐助
210  
注册时间
2007-10-26 
1楼 跳转到 » 倒序看帖
打印
tT
发表于 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

Rank: 8Rank: 8

帖子
962 
积分
2449 
技术
40  
捐助
0  
注册时间
2007-10-25 
2楼
发表于 2009-9-30 09:39 | 只看该作者
测试代码（使用方法：将本程序拷贝到待处理txt文件所在目录，运行即可）：
  1. msg="注意：程序运行期间，请不要操作word!" & vbcrlf & vbcrlf

  2. msg=msg & "使用方法：将本程序拷贝到待处理txt文件所在目录，运行即可!"

  3. 

  4. msg=msg & vbcrlf & vbcrlf & "开始处理?"

  5. CH=msgbox(msg,vbokcancel,"Txt2Word")

  6. if CH<>1 then wscript.quit

  7. 

  8. on error Resume next

  9. Const ForReading = 1, ForWriting = 2

  10. Set FSO = CreateObject("Scripting.FileSystemObject")

  11. set FF=FSO.getfolder(".")

  12. set FC=FF.files

  13. 

  14. set WordApp=CreateObject("word.application")

  15. WordApp.visible=Visible

  16. WordApp.Documents.Add

  17. set MyWord=WordApp.Activedocument

  18. 

  19. FolderPath=FF.path

  20. For each fl in FC

  21. 	ext=Lcase(fso.GetExtensionName(fl))

  22. 	if ext="txt" then

  23. 		Set f = fso.OpenTextFile(fl, ForReading)

  24. 		FileContent=f.readall

  25. 		FileName=split(fl.name,".")

  26. 		f.close

  27. 		MyWord.Content.text=FileContent

  28. 		

  29. 		MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"

  30. 		wscript.sleep 1000

  31. 	end if

  32. Next

  33. WordApp.quit(0)

  34. 

  35. msgbox "恭喜你，转换完成!",vbokonly+vbinformation,"Txt2Doc"

  36. set FC=nothing

  37. set FF=nothing

  38. Set FSO=nothing
复制代码
1

评分人数

TOP

youxi01

Rank: 8Rank: 8

帖子
962 
积分
2449 
技术
40  
捐助
0  
注册时间
2007-10-25 
3楼
发表于 2009-9-30 12:00 | 只看该作者
在上面代码的基础上添加了一些格式设置(按自己要求修改其中的配置信息)
  1. on error Resume next

  2. 

  3. '/*/////////////////////配置信息////////////////////////////////////

  4. FontSize=16                        '字体大小

  5. FontName="黑体"                        '字体名称

  6. Bold=True                        '是否粗体：是则为True，否为false

  7. TextColumnNum=1                        'Word页面栏数

  8. LineSpacing = 21                '行距固定值

  9. 

  10. TopMargin =2                        '上边距

  11. BottomMargin =2                        '下边距

  12. LeftMargin =2                        '左边距

  13. RightMargin =2                        '右边距

  14. '/*////////////////////////////////////////////////////////////////

  15. 

  16. msg="注意：程序运行期间，请不要操作word!" & vbcrlf & vbcrlf

  17. msg=msg & "使用方法：将本程序拷贝到待处理txt文件所在目录，运行即可!"

  18. 

  19. msg=msg & vbcrlf & vbcrlf & "开始处理?"

  20. CH=msgbox(msg,vbokcancel,"Txt2Word")

  21. if CH<>1 then wscript.quit

  22. 

  23. Const ForReading = 1, ForWriting = 2

  24. Set FSO = CreateObject("Scripting.FileSystemObject")

  25. set FF=FSO.getfolder(".")

  26. set FC=FF.files

  27. 

  28. set WordApp=CreateObject("word.application")

  29. WordApp.visible=Visible

  30. WordApp.Documents.Add

  31. set MyWord=WordApp.Activedocument

  32. MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1                '页脚居中对齐

  33. 

  34. '/*////////////////////对word格式进行设置////////////////////

  35. With MyWord.Content.Font

  36.         .Size = FontSize

  37.         .Name = FontName

  38.         .Bold = Bold

  39. End With

  40. 

  41. With MyWord.PageSetup

  42.         .TopMargin =TopMargin * 28.35

  43.         .BottomMargin =BottomMargin * 28.35

  44.         .LeftMargin =LeftMargin * 28.35

  45.         .RightMargin =RightMargin * 28.35

  46. End With

  47. 

  48. MyWord.PageSetup.TextColumns.SetCount TextColumnNum

  49. 

  50. With MyWord.Content.ParagraphFormat

  51.         .LineSpacingRule = 4

  52.         .LineSpacing = LineSpacing

  53. End With

  54. '/*//////////////////////////////////////////////////////////

  55. 

  56. FolderPath=FF.path

  57. For each fl in FC

  58.         ext=Lcase(fso.GetExtensionName(fl))

  59.         if ext="txt" then

  60.                 Set f = fso.OpenTextFile(fl, ForReading)

  61.                 FileContent=f.readall

  62.                 FileName=split(fl.name,".")

  63.                 f.close

  64.                 MyWord.Content.text=FileContent

  65.                 

  66.                 MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"

  67.                 wscript.sleep 1000

  68.         end if

  69. Next

  70. WordApp.quit(0)

  71. 

  72. msgbox "恭喜你，转换完成!",vbokonly+vbinformation,"Txt2Doc"

  73. set FC=nothing

  74. set FF=nothing

  75. Set FSO=nothing
复制代码
1

评分人数

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

TOP

随风

Rank: 8Rank: 8

帖子
1759 
积分
5387 
技术
51  
捐助
210  
注册时间
2007-10-26 
4楼
发表于 2009-9-30 13:20 | 只看该作者

回复 3楼 的帖子

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

TOP

523066680

Rank: 7Rank: 7Rank: 7

帖子
3151 
积分
6455 
技术
317  
捐助
70  
注册时间
2008-8-3 
5楼
发表于 2009-9-30 17:39 | 只看该作者
打开 一个word文档，货excel文档
工具--宏--【visual basic 编辑器】
然后出了一个新界面~  在新界面中选   【视图】-【对象浏览器】

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

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

TOP

随风

Rank: 8Rank: 8

帖子
1759 
积分
5387 
技术
51  
捐助
210  
注册时间
2007-10-26 
6楼
发表于 2009-10-2 08:13 | 只看该作者

回复 3楼 的帖子

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

TOP

youxi01

Rank: 8Rank: 8

帖子
962 
积分
2449 
技术
40  
捐助
0  
注册时间
2007-10-25 
7楼
发表于 2009-10-2 10:40 | 只看该作者
新代码略作修正如下：
  1.  

  2. on error Resume next

  3. '/*/////////////////////配置信息////////////////////////////////////

  4. FontSize=16                        '字体大小

  5. FontName="黑体"                        '字体名称

  6. Bold=True                        '是否粗体：是则为True，否为false

  7. TextColumnNum=1                        'Word页面栏数

  8. LineSpacing = 21                '行距固定值

  9. TopMargin =2                        '上边距

  10. BottomMargin =2                        '下边距

  11. LeftMargin =2                        '左边距

  12. RightMargin =2                        '右边距

  13. isHeader=false   '是否设置页眉，是为True，否为false

  14. '/*////////////////////////////////////////////////////////////////

  15. msg="注意：程序运行期间，请不要操作word!" & vbcrlf & vbcrlf

  16. msg=msg & "使用方法：将本程序拷贝到待处理txt文件所在目录，运行即可!"

  17. msg=msg & vbcrlf & vbcrlf & "开始处理?"

  18. CH=msgbox(msg,vbokcancel,"Txt2Word")

  19. if CH<>1 then wscript.quit

  20. Const ForReading = 1, ForWriting = 2

  21. Set FSO = CreateObject("Scripting.FileSystemObject")

  22. set FF=FSO.getfolder(".")

  23. set FC=FF.files

  24. set WordApp=CreateObject("word.application")

  25. WordApp.visible=Visible

  26. WordApp.Documents.Add

  27. set MyWord=WordApp.Activedocument

  28. MyWord.Sections(1).Footers(1).PageNumbers.Add.Alignment=1                '页脚居中对齐

  29. Myword.Sections(1).Headers(1).Range.ParagraphFormat.Alignment = 1 '页眉居中对齐

  30. '/*////////////////////对word格式进行设置////////////////////

  31. With MyWord.Content.Font

  32.         .Size = FontSize

  33.         .Name = FontName

  34.         .Bold = Bold

  35. End With

  36. With MyWord.PageSetup

  37.         .TopMargin =TopMargin * 28.35

  38.         .BottomMargin =BottomMargin * 28.35

  39.         .LeftMargin =LeftMargin * 28.35

  40.         .RightMargin =RightMargin * 28.35

  41. End With

  42. MyWord.PageSetup.TextColumns.SetCount TextColumnNum

  43. With MyWord.Content.ParagraphFormat

  44.         .LineSpacingRule = 4

  45.         .LineSpacing = LineSpacing

  46. End With

  47. '/*//////////////////////////////////////////////////////////

  48. FolderPath=FF.path

  49. For each fl in FC

  50.         ext=Lcase(fso.GetExtensionName(fl))

  51.         if ext="txt" then

  52.                 Set f = fso.OpenTextFile(fl, ForReading)  

  53.   FirstLine=f.ReadLine

  54.   if isHeader=True then 

  55.    Myword.Sections(1).Headers(1).Range.text=FirstLine

  56.   else

  57.    WordApp.ActiveWindow.ActivePane.View.SeekView =9

  58.        WordApp.ActiveWindow.ActivePane.View.SeekView =0

  59.   end if

  60.                 FileContent=FirstLine & vbcrlf & f.readall

  61.                 FileName=split(fl.name,".")

  62.                 f.close

  63.                 MyWord.Content.text=FileContent

  64.                 

  65.                 MyWord.SaveAs FolderPath & "\" & FileName(0) & ".doc"

  66.                 wscript.sleep 1000

  67.         end if

  68. Next

  69. WordApp.quit(0)

  70. msgbox "恭喜你，转换完成!",vbokonly+vbinformation,"Txt2Doc"

  71. set FC=nothing

  72. set FF=nothing

  73. Set FSO=nothing
复制代码

TOP

随风

Rank: 8Rank: 8

帖子
1759 
积分
5387 
技术
51  
捐助
210  
注册时间
2007-10-26 
8楼
发表于 2009-10-2 15:08 | 只看该作者

回复 7楼 的帖子

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

TOP

返回列表