VB Script Error - работал раньше, но теперь не запутанно - PullRequest
2 голосов
/ 07 октября 2011

я получаю сообщение об ошибке

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 Ответ

1 голос
/ 05 февраля 2012

Если строка 68

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

действительно является виновником, я бы сказал:

  1. Объекты objLog, objFile и colMatches использовались ранее- acquittal
  2. Методы .WriteLine, .Name и .Count выглядят хорошо - acquittal
  3. Конкатенация (&) должна работать со строковыми литералами, а не с элементами null / empty / nothing - acquittal
  4. По исключению: objFile.Name содержит забавное письмо (не конвертируемое в 'ASCII').Простая проверка: замените «objFile.Name» строковым литералом.

Доказательства

  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
====================================
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...