a20150604

回复 1# chong08

Rem^ & @echo off & mode 300,9999
Rem^ &cscript //NoLogo //E:VBScript "%~f0"
Rem^ &pause
Rem^ &goto :eof

Public yyyyMMdd
Call main
Sub main()
    dttm = Now
    yyyyMMdd = Year(dttm) & "" & Right("0" & Month(dttm), 2) & "" & Right("0" & Day(dttm), 2)
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 脚本对象 和 当前目录
    Set obj_wsc_shell = CreateObject("wscript.shell")
    HostFolder = obj_wsc_shell.CurrentDirectory & "\"
    ' HostFolder = ThisWorkbook.Path & "\"
    Call DoFolder(fso.GetFolder(HostFolder))
    wscript.Quit
End Sub
Sub DoFolder(Folder)
    ' 在子目录中递归调用
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        Call DoFolder(SubFolder)
    Next
    Dim file
    For Each file In Folder.Files
        Call doFile(file)
    Next
End Sub
Sub doFile(ByRef input_file)
    ' 分解获取 文件名 和 扩展名
    If InStr(input_file.Name, ".") > 0 Then
        arr = Split(input_file.Name, ".")
        ext_name = UCase(arr(UBound(arr)))
        dot_ext_name = "." & ext_name
    Else
        ext_name = ""
        dot_ext_name = ""
    End If
    ' 跳过 非 TIF 文件
    If Not ("TIF" = ext_name) Then
        Exit Sub
    End If
    
    file_name = Left(input_file.Name, Len(input_file.Name) - Len(dot_ext_name))
    
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "\d+_\d+_([^\-\s]+)-[^\d]*(\d+)[\s\S]*(Yellow|Black|Cyan|Magenta)"
    regEx.IgnoreCase = True
    Rem regEx.Global = True
    wscript.echo "file_name:" & file_name
    Set oMatches = regEx.Execute(file_name)
    If oMatches.Count > 0 Then
        Set oMatch = oMatches(0)
        wscript.echo "file_name:" & file_name & " 0:" & oMatch.SubMatches(0) & " 1:" & oMatch.SubMatches(1) & " 2:" & oMatch.SubMatches(2)
        new_name = ""
        Select Case oMatch.SubMatches(0)
            Case "光明日报"
                new_name = new_name & "gmrb" & "-"
            Case "第一财经"
                new_name = new_name & "dycj" & "-"
        End Select
        new_name = new_name & Right("00" & oMatch.SubMatches(1), 3) & "-" & yyyyMMdd
        Select Case UCase(oMatch.SubMatches(2))
            Case "BLACK"
                new_name = new_name & "-" & "k"
            Case "CYAN"
                new_name = new_name & "-" & "c"
            Case "MAGENTA"
                new_name = new_name & "-" & "m"
            Case "YELLOW"
                new_name = new_name & "-" & "y"
        End Select
        wscript.echo new_name
        input_file.Name = new_name & dot_ext_name
    Else
        wscript.echo input_file.Path & " 解析失败"
    End If
End Sub
复制代码