（已解决）我又来了，关于个提取同目录下文件夹内图片文件名称的问题

excelkill

wanghan519 发表于 2024-2-5 04:10
其实，识别图片里的标题再重命名也行，用的是论坛大佬分享的接口

你好老师：能麻烦解析一下这个如何使用吗？我刚才测试过运行bat文件后，dos窗口显示后，没有结果啊

wanghan519

excelkill 发表于 2024-2-5 09:07
你好老师：能麻烦解析一下这个如何使用吗？我刚才测试过运行bat文件后，dos窗口显示后，没有结果啊

给两个例子图片吧，还有说明要怎样命名

呃，上面的附件只是说，可以从图片里的文字获取表名，后面重命名图片，整理成表没写

excelkill

ykcbf1100 发表于 2024-2-4 22:16
用正则提取文件名
附件供参考。。。

ykcbf1100老师：测试中发现个新问题，就是编号栏有多个重复编号问题，现在报错了，多个重复编号不是错误信息，就是这个人有多条记录，现在能不能加个判断，只要是重复的取最上面的信息，或者采取其他办法，同一编号的姓名肯定也是一样的，麻烦老师帮助修改一下

limonet

关键字：unique+recurse，也许不是最优解.

limonet

Sub limonet()
    Dim Arr As Variant, S$, StrT$, Brr() As Variant, Crr As Variant, i%, j%
    Arr = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
    ReDim Brr(1 To UBound(Arr), 1 To 3)
    Crr = Array("审批表", "制度|协议|规定", "工资表|工资凭单|凭证")
    S = CreateObject("wscript.shell").exec("PowerShell $FormatEnumerationLimit=-1;get-childitem " & ThisWorkbook.Path _
        & "\名单 -recurse -file | Select  @{Name='Name';Expression={$_.name -Replace '[^一-龥]',''}},@{Name='Directory';Expression={$_.Directory -Replace '.*\\',''}} " _
        & "| Get-Unique -AsString | Group  directory |select name, @{Name='Group';Expression={$_.Group -Replace '[^一-龥]',''}}").stdout.readall
    With CreateObject("vbscript.regexp")
        For i = 1 To UBound(Arr)
            .Pattern = Arr(i, 1) & ".*?}": .Global = True
            StrT = .Execute(S)(0)
            For j = 1 To 3
                .Pattern = Crr(j - 1)
                If j - 1 Then
                    For Each ms In .Execute(StrT)
                        Brr(i, j) = Brr(i, j) & "，" & ms
                    Next ms
                    Brr(i, j) = Mid(Brr(i, j), 2)
                Else
                    If .test(StrT) Then
                        Brr(i, j) = "有"
                    Else
                        Brr(i, j) = "无"
                    End If
                End If
            Next j
        Next i
    End With
    Range("h2").Resize(i - 1, j - 1) = Brr
End Sub

limonet

其实，powershell是获得这个数据