开发者

VB Script Error - Worked before but now not confusingly

i am getting a error

VB Script Error - Worked before but now not confusingly

The VB file reads col1 and finds the matching image name in the directory and the renames that file to col2 it produces a report to show what images haven't been renamed and placed the ones that have in a folder called rename

i have attached the code so you can see

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
          开发者_StackOverflow              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"

Thanks

Jack


If line 68

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

is really the culprit, I would argue:

  1. The objects objLog, objFile, and colMatches were used before - acquittal
  2. The methods .WriteLine, .Name, and .Count look good - acquittal
  3. Concatenation (&) should work on string literals and not null/empty/nothing elements - acquittal
  4. By elimination: objFile.Name contains a funny letter (not convertable to 'ASCII'). Easy check: Replace "objFile.Name" with a string literal.

Evidence

  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

output:

====================================

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

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜