VB脚本错误 - 以前工作但现在不容易混淆

时间:2011-10-07 09:44:24

标签: vbscript

我收到错误

Error i am getting

VB文件读取col1并在目录中找到匹配的图像名称,并将该文件重命名为col2,它生成一个报告,以显示尚未重命名的图像,并将其放在名为rename的文件夹中

我附上了代码,您可以看到

strDocMap = "C:\img\DocMap.xlsx"
strInputFolder = "C:\img\"
strOutputFolder = "C:\img\renamed\"
strLogFile = "C:\img\RenamingLog.txt" 
strPattern = "\d{5}"

Set regExpression = New RegExp
With regExpression
.Global = True
.IgnoreCase = True
.Pattern = strPattern
End With
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Const xlUp = -4162
Const xlFormulas = -4123
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1
Set objWB = objExcel.Workbooks.Open(strDocMap, False, True)
Set objSheet = objWB.Sheets(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Right(strInputFolder, 1) <> "\" Then strInputFolder = strInputFolder & "\"
If Right(strOutputFolder, 1) <> "\" Then strOutputFolder = strOutputFolder & "\"

If objFSO.FolderExists(strOutputFolder) = False Then objFSO.CreateFolder strOutputFolder
Set objLog = objFSO.CreateTextFile(strLogFile, True)
objLog.WriteLine "Script started " & Now
objLog.WriteLine "Enumerating files in folder: " & strInputFolder
objLog.WriteLine "Renaming files to folder: " & strOutputFolder
objLog.WriteLine String(80, "=")

For Each objFile In objFSO.GetFolder(strInputFolder).Files
Set colMatches = regExpression.Execute(objFile.Name)
If colMatches.Count > 0 Then
    If colMatches.Count = 1 Then
        For Each objMatch In colMatches
            strOldNum = objMatch.Value
            Set objCell = objSheet.Cells.Find(strOldNum,         objSheet.Range("A1"), xlFormulas, xlPart, xlByRows, xlNext, False, False)
            If Not objCell Is Nothing Then
                strNewNum = objCell.Offset(0, 1).Value
                If strNewNum <> "" Then
                    strNewPath = strOutputFolder & strNewNum & "." & objFSO.GetExtensionName(objFile.Path)
                    ' Check if a file already exists without the appended letter
                    blnValid = True
                    If objFSO.FileExists(strNewPath) = True Then
                        blnValid = False
                        ' Start at "a"
                        intLetter = 97
                        strNewPath = strOutputFolder & strNewNum & Chr(intLetter) & "." & objFSO.GetExtensionName(objFile.Path)
                        Do While objFSO.FileExists(strNewPath) = True
                            intLetter = intLetter + 1
                            strNewPath = strOutputFolder & strNewNum & Chr(intLetter) & "." & objFSO.GetExtensionName(objFile.Path)
                            If intLetter > 122 Then Exit Do
                        Loop
                        If intLetter <= 122 Then blnValid = True
                    End If
                    If blnValid = True Then
                        objLog.WriteLine "Renaming " & objFile.Name & " to " & Mid(strNewPath, InStrRev(strNewPath, "\") + 1)
                        objFSO.MoveFile objFile.Path, strNewPath
                    Else
                        objLog.WriteLine "Unable to rename " & objFile.Name & ". Letters exhausted."
                    End If
                End If
            End If
        Next
    Else
        objLog.WriteLine objFile.Name & " contains " & colMatches.Count & " matches. Manual adjustment required."
    End If
End If
Next
objLog.WriteLine String(80, "=")
objLog.WriteLine "Script finished " & Now
objWB.Close False
objExcel.Quit

objLog.Close
MsgBox "Done"

由于

杰克

1 个答案:

答案 0 :(得分:1)

如果 68

objLog.WriteLine objFile.Name & " contains " & colMatches.Count & " matches. Manual adjustment required."

真的是罪魁祸首,我认为:

  1. 之前使用过对象objLog,objFile和colMatches - 开释
  2. 方法.WriteLine,.Name和.Count看起来很好 - 无罪释放
  3. 连接(&amp;)应该对字符串文字起作用而不是 null / empty / nothing elements - acquittal
  4. 通过消除:objFile.Name包含一个有趣的字母(不是 可转换为'ASCII')。轻松检查:将“objFile.Name”替换为 string literal。
  5. 证据

      Dim s
      For Each s In Array(Empty, Null, ChrW(1234))
        On Error Resume Next
         goFS.CreateTextFile("tmp.txt", True).WriteLine s
         WScript.Echo Err.Description
        On Error GoTo 0
      Next
    

    输出:

    ====================================
    
    Type mismatch
    Invalid procedure call or argument
    ====================================