VBS怎样根据word内容标题自动重命名word文件名？

yhcbird · 发表于 2011-1-26 17:15:31

set fso=createobject("scripting.filesystemobject")
set folder=fso.getfolder(".")
set files=folder.files
for each file in files
if lcase(right(file,3))="doc" then
a=1
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(cstr(file))
wjm=objDoc.Paragraphs(1).Range
objWord.Quit
if file.name <> replace(wjm,vbcr,"") & ".doc" then createobject("wscript.shell").run "cmd /c ren " & chr(34) & file.name & chr(34) & " " & chr(34) & wjm & ".doc" & chr(34),0
end if
next
if a=1 then
msgbox "操作成功!",4096,"提示"
else
msgbox "对不起，没有在【" & folder & "】下找到WORD文件",4096,"提示"
end if

复制代码

这是一段根据word内容标题自动为word重命名的代码。这段代码是从网上复制过来的
刚把这快代码发在批处理版块了。。这里想请各位帮忙看下这段代码怎么改进比较。可以减少错误发生率。。
因为在执行的时候会第几行错误。。。貌似假如文件内容标题在第二行，第一行是空行的，就不会自动搜索第2行的标题，望高手看个端倪。。

[ 本帖最后由 yhcbird 于 2011-1-26 17:21 编辑 ]

broly · 发表于 2011-1-26 22:21:27

Word.Application对象没用过

待我研究一番先

broly · 发表于 2011-1-27 01:27:32

刚开完盘车，然后看了下这题，写了代码如下：

Dim fso,fc,f,strName
Set fso = CreateObject("scripting.filesystemobject")
Set fc=fso.GetFolder(".").Files
For Each f In fc
If LCase(fso.GetExtensionName(f))="doc" Then
strName=GetFileName(f.Path)
End If
f.Name=strName & ".doc"
Exit For
Next
Set fso=Nothing
Function GetFileName(FilePath)
Dim i,objWord,Doc
Set objWord=CreateObject("word.application")
Set Doc=objWord.Documents.Open(FilePath)
For i=1 To Doc.Paragraphs.Count
If Replace(Doc.Paragraphs(i).Range," ","")<>vbCr Then
GetFileName=Replace(Doc.Paragraphs(i).Range,vbCr,"")
Exit For
End If
Next
objWord.Quit
Set objWord=Nothing
End Function

复制代码

这个代码有点还不是很到位的，就是，如果标题含有特殊字符 \ / * | 之类的，那必须要过滤。其实用replace语句可以解决的，这里我偷下懒就不写了，睡觉，晚安~

yhcbird · 发表于 2011-1-28 09:35:31

辛苦了。测试下。没有成功。。。

broly · 发表于 2011-1-28 11:36:20

哦？我测试是没有问题的。出错提示什么？

		自动登录	找回密码
密码			注册

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

VBS怎样根据word内容标题自动重命名word文件名？

浏览过的版块