首页 > 解决方案 > 运行 IF then else 循环异常

问题描述

我必须(将)使用 FDM(免费下载管理器)从 INSEE(法国统计局)下载数百个文件。因此,我使用脚本重命名这些下载的文件以找到每个公社的五位数 Insee 代码(在文件的第二行中)并将它们放在文件名之前,因此rp009_cc_pop.xls变为67181_rp009_cc_pop.txt。那些下载的 .xls 文件不是真正的 Excel 文件,而是扩展名错误的纯文本文件。有时会有一个下载的文件在其内容中没有“commune”(带空格)这个词。如何跳过这些文件的重命名。所以一个好的建议是昂贵的。这是脚本:

Dim objFso, strFolder
 ' Begin Main
 Set objFso = CreateObject("Scripting.FileSystemObject")
 strFolder = objFso.GetParentFolderName(WScript.ScriptFullName)  
 If objFso.FolderExists(strFolder) Then
 Call GetJspFiles(objFso.GetFolder(strFolder))
End If
Set objFso = Nothing
' End Main

Sub GetJspFiles(ByRef objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
    If LCase(objFso.GetExtensionName(objFile.Name)) = "xls" Then
        Call JSPRename(objFile.Path, objFolder.Path)
    End If
Next
For Each objSubFolder In objFolder.SubFolders
  Call GetJSPRename(objSubFolder)
Next
' objFile.Close
End Sub

Sub JSPRename(ByRef strPath, ByRef strFolder)
Dim arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz
Set objJspFile = objFso.OpenTextFile(strPath)
arrText = Split(objJspFile.ReadAll, vbCrLf) ' split into lines
For Each strTextLine In arrText
  If strTextLine <> "" Then
     strText = Trim(strTextLine)
   If Instr(1,strText,"Commune ",1) Then
    Position=Instr(1, strText, "(",1)
   newFilename=mid(strText,Position+1, 5) ' 5 Characters long
   else
   end if
else
' newFilename=......  ' <== skip those files without the word 'commune ' from renaming
  end if
Next
objJspFile.Close
cutlastoff=Left(strPath, inStrRev(strPath,"\")-1)
strNewName = cutlastoff & "\" & newFilename & "_rp009_cc_pop.txt"  ' cutting the filename
Wscript.echo "New Name: " & strNewName & vbcrlf & "Old Name: " & strPath 
'!! only for Showing the results

objFSO.MoveFile strPath, strNewName
End Sub

非常感谢您提供任何受欢迎的提示

标签: vbscript

解决方案


我通常在原始 for 循环和任何其他循环中使用嵌套循环来跳过一个项目。您必须确保嵌套循环不会循环,因此您的原始脚本不会受到影响,因此使用 Do {...} Loop While False。

For Each strTextLine In arrText : Do 'Easy skip door
  If strTextLine <> "" Then
     strText = Trim(strTextLine)
   If Instr(1,strText,"Commune ",1) Then
    Position=Instr(1, strText, "(",1)
   newFilename=mid(strText,Position+1, 5) ' 5 Characters long
   else
   end if
else
   Exit Do 'Take the easy skip door
' newFilename=......  ' <== skip those files without the word 'commune ' from renaming
  end if
Loop While False : Next 'Don't forget to close the skip door.

编辑:我很抱歉,我想我太兴奋了,不能做我的第一篇文章。我会留下原帖提醒我下次不要走得太快。

下面的 Sub 会将布尔变量初始化为 False 以用作开关。然后它将查找您的值,如果找到它,则将布尔变量设置为 True,并根据该布尔变量的值执行其余代码。

Sub JSPRename(ByRef strPath, ByRef strFolder)

    Dim boolNumberFound, arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz

    boolNumberFound = False '<-----------
    Set objJspFile = objFso.OpenTextFile(strPath)
    arrText = Split(objJspFile.ReadAll, vbCrLf) ' split into lines


    For Each strTextLine In arrText
        If strTextLine <> "" Then
            strText = Trim(strTextLine)
            If Instr(1,strText,"Commune ",1) Then
                Position=Instr(1, strText, "(",1)
                newFilename=mid(strText,Position+1, 5) ' 5 Characters long
                boolNumberFound = True '<-----------
                Exit For
            end if
        end if
    Next

    If boolNumberFound Then '<-----------
        objJspFile.Close
        cutlastoff=Left(strPath, inStrRev(strPath,"\")-1)
        strNewName = cutlastoff & "\" & newFilename & "_rp009_cc_pop.txt"  ' cutting the filename
        Wscript.echo "New Name: " & strNewName & vbcrlf & "Old Name: " & strPath 
        '!! only for Showing the results

        objFSO.MoveFile strPath, strNewName
    Else
        Wscript.echo "Commune # not found in file: '" & strPath & "'. File was skipped."
    End If

End Sub

我还冒昧地使用正则表达式对象编写了您的 sub 的新版本。这些更快,更灵活。虽然我没有测试它。根据自己的喜好使用它。

Sub JSPRename(ByRef strPath, ByRef strFolder)

    Dim objJspFile, CommuneNo, arr_path, strNewName
    Dim re, re_matches, re_first_match

    Set objJspFile = objFso.OpenTextFile(strPath)
    Set re = New RegExp

    re.Pattern = "(Commune *\()(\d{5})" 
    'A match will return 2 submatches:
        'submatch(0)="Commune("
        'submatch(1)=[Your 5 digits]

    Set re_matches = re.Execute(objJspFile.ReadAll)

    If re_matches.count Then 'There is at least 1 occurence
        Set re_first_match = re_matches(0)
        CommuneNo = re_first_match.SubMatches(1)
    Else
        WScript.Echo strPath & " did not contain Commnune# and was skipped."
        Exit Sub 'This exits your sub without renaming the file
    End If

    Set re = Nothing

    objJspFile.Close
    Set objJspFile = Nothing


    arr_path = Split(strPath, "\")
    arr_path(UBound(arr_path)) = CommuneNo & "_" & arr_path(UBound(arr_path))
    strNewName = Join(arr_path, "\")

    Wscript.echo "New Name: " & strNewName & vbcrlf & "Old Name: " & strPath 
    '!! only for Showing the results

    objFSO.MoveFile strPath, strNewName

End Sub

推荐阅读