[已解决]难度可能比较大 -工作中实际案例，照片重命名问题

sparkguo

工作中遇到的实际问题，证书报名 上传附件操作很麻烦，尝试找找各位老师，看看有没有可能解决
辛苦了啊
详见附件

最佳答案

月排行榜 / 总排行榜

我行我速2008

2022-8-24 20:55

Sub tt()
    On Error Resume Next
    Dim D1 As Object
    Dim D2 As Object
    Dim MyFile As Object
    Dim F, Fd
    Dim Ar, Br, R%, K%, StrPath$
    Set D1 = CreateObject("scripting.dictionary")
    Set D2 = CreateObject("scripting.dictionary")
    Set MyFile = CreateObject("Scripting.FileSystemObject")
    StrPath = ThisWorkbook.Path & "\原始照片"
    Ar = Sheets("数据区域").[a1].CurrentRegion
    For R = 2 To UBound(Ar)
        D1(Ar(R, 3)) = Ar(R, 7)
        D2(Ar(R, 3)) = Ar(R, 5)
    Next R
    Br = Sheets("操作区域").[b2].CurrentRegion
    For Each Fd In MyFile.getfolder(StrPath).subfolders
        For Each F In Fd.Files
            For R = 5 To UBound(Br)
                If F.Name Like Br(R, 1) & "*头*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "t.jpg"
                ElseIf F.Name Like Br(R, 1) & "*学*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "x.jpg"
                ElseIf F.Name Like Br(R, 1) & "*工作年限*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "g.jpg"
                ElseIf F.Name Like Br(R, 1) & "*身份证1*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "z.jpg"
                ElseIf F.Name Like Br(R, 1) & "*身份证2*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "f.jpg"
                ElseIf F.Name Like Br(R, 1) & "*报名*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "b" & D2(Br(R, 1)) & ".jpg"
                End If
            Next R
        Next F
    Next Fd
    Set MyFile = Nothing
End Sub

跳转到最佳答案楼层

我行我速2008

Sub tt()
    On Error Resume Next
    Dim D1 As Object
    Dim D2 As Object
    Dim MyFile As Object
    Dim F, Fd
    Dim Ar, Br, R%, K%, StrPath$
    Set D1 = CreateObject("scripting.dictionary")
    Set D2 = CreateObject("scripting.dictionary")
    Set MyFile = CreateObject("Scripting.FileSystemObject")
    StrPath = ThisWorkbook.Path & "\原始照片"
    Ar = Sheets("数据区域").[a1].CurrentRegion
    For R = 2 To UBound(Ar)
        D1(Ar(R, 3)) = Ar(R, 7)
        D2(Ar(R, 3)) = Ar(R, 5)
    Next R
    Br = Sheets("操作区域").[b2].CurrentRegion
    For Each Fd In MyFile.getfolder(StrPath).subfolders
        For Each F In Fd.Files
            For R = 5 To UBound(Br)
                If F.Name Like Br(R, 1) & "*头*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "t.jpg"
                ElseIf F.Name Like Br(R, 1) & "*学*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "x.jpg"
                ElseIf F.Name Like Br(R, 1) & "*工作年限*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "g.jpg"
                ElseIf F.Name Like Br(R, 1) & "*身份证1*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "z.jpg"
                ElseIf F.Name Like Br(R, 1) & "*身份证2*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "f.jpg"
                ElseIf F.Name Like Br(R, 1) & "*报名*" Then
                    Name F.Path As Fd.Path & "\" & D1(Br(R, 1)) & "b" & D2(Br(R, 1)) & ".jpg"
                End If
            Next R
        Next F
    Next Fd
    Set MyFile = Nothing
End Sub