请高手帮忙检查一下，这段代码有什么问题？

jmjslkj

我想用word文档的标题重新命名文件，在网上找了这段代码，可以运行，但不出现重新命名的结果，请高手帮忙检查一下，这段代码有什么问题？
代码如下：

Function GetTitle(wrd, fileName)
on error resume next
    Dim strTitle, strWord
    Dim i
    dim ThisDocument
    wrd.Documents.Open(fileName)
    strTitle = ""
    if Err.Number <> 0 then
     Err.clear
else
     strTitle = ""
     set ThisDocument = wrd.ActiveDocument
     if (ThisDocument.Words.Count > 0) then
         For i = 1 To ThisDocument.Words.Count
             strWord = ThisDocument.Words.Item(i)
             If Asc(strWord) = 13 and strTitle <> "" Then
                 Exit For
             End If
         
          if Asc(strWord) <> 13 then
              strTitle = strTitle + strWord
              if(len(strTitle) > 200) then exit for
             end if
         Next
     else
          GetTitle = "del"
     end if
     wrd.ActiveDocument.Close
end if
    GetTitle = replace(strTitle,vbCrLf,"")
   
End Function


sub main
dim wrd
dim strDir,strFileName, strFileExt, strFilePath, strFileTitle,strNewTitle, strCmdLine
dim objFSO , objFolder, objFile, objLog
dim nPos, nIndex
set wrd = CreateObject("Word.Application")
wrd.visible=true

wrd.application.activate
    strDir = "."

    set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDir)
    Set objLog = objFSO.CreateTextFile("rename.bat", True, True)
   
    '&acute;&acute;&frac12;¨&Auml;&iquest;&Acirc;&frac14;
    if not objFSO.FolderExists("deleted") then
     objFSO.CreateFolder("deleted")
    end if
   
if not objFSO.FolderExists("emptyFiles") then
     objFSO.CreateFolder("emptyFiles")
    end if

    nIndex = 1
    for each objFile in objFolder.Files
        nPos = InStrRev(objFile, "\")
     strFilePath = mid(objFile, 1, nPos)
        strFileName = mid(objFile, nPos + 1)

        nPos = InStrRev(strFileName , ".")
     strFileTitle = mid(strFileName , 1, nPos)
        strFilePathExt = mid(strFileName , nPos + 1)

        if (ucase(strFilePathExt) = "DOC") and (asc(mid(strFileTitle ,1,1)) <> 126) then
      strNewTitle = GetTitle(wrd, objFile & "")
      if (not isnull(strNewTitle)) and (trim(strNewTitle) <> "") then
        if(strNewTitle = "del") then
         strCmdLine = "move " + strFileName + " deleted\"
        else
        
                  nIndex = nIndex + 1
                  strCmdLine = "ren """ + strFileName + """ """ + strNewTitle & "_" & nIndex &  ".doc"""
              end if
          else
       strCmdLine = "move " + strFileName + " emptyFiles\"
          end if
        end if
        objLog.WriteLine(strCmdLine )
        strCmdLine = ""

    next   
  
    objLog.Close
end sub

main

banjinjiu

1、首先要了解文件命名规则，就是你的标题的字符要符合文件命名规则。不然的话文件名到非法字符前就断了。
2、文件命名规则（整理不知道是否准确，大概是那个意思）：
⑴文件名称不得超过255个字符。
⑵文件名开头不可以使用空格。
⑶文件名中不能有下列符号：“？”、“、”、“\”、“*”、““”、“””、“<”、“>”、“|”。
3、Word文档未保存前，都叫“文档 i”（中间有个空格），这个“i”是数字，从1开始的自然数。
4、所以你的题目分两种情况处理：一是未保存；二是已保存，那就要重命名文件。
下面是未保存情况的代码。重命名情况比较复杂，因为在打开原文件的情况下是无法重命名的。两种情况并在一个代码，需要判断。

1. Sub保存文件()
   
2. x = ActiveDocument.Paragraphs(1)
   
3. x = Replace(x, Chr(7), "")
   
4. x = Replace(x, Chr(13), "")
   
5. Path = "f:\保存位置"
   
6. ActiveDocument.SaveAs Path & "" & x
   
7. End Sub

复制代码

有时间再搞。

jmjslkj

谢谢了，我是外行，想试试