用VBA批处理照片复制改名

操作如下，新建一个文件夹，在这个文件夹中建一个excel文件和两个文件夹，文件夹分别命名为照片汇总和照片库，打开excel文件，建一个按钮，双击按钮在代码区输入如下代码，保存就可以了。完成VBA宏制作后，将整理好的带文件夹的照片放到照片库中，双击照片库，你看到的是一个个的文件夹，再点击文件夹时，就可以看到照片了。好了，回到excel文件，保证照片汇总文件夹为空，双击按钮，就会执行一段时间的代码，操作是在excel文件中写入一张照片的名称，同时在照片汇总文件夹中复制并重命名一个照片文件。电脑快的话，几分钟就全部搞定所有照片了。下面是VBA宏代码，window2003、excel2003环境测试通过。

Private Sub CommandButton1_Click()
    j = 0
    Set rrr = CreateObject("scripting.filesystemobject")
    Set r = rrr.getfolder(ThisWorkbook.Path & "\照片库")
    For Each i In r.subfolders
        MyFileName = Dir(i & "\*.jpg")
        rowi = 0
        Do While MyFileName <> ""
            j = j + 1
            rowi = rowi + 1
            k = Right(i, Len(i) - InStrRev(i, "\"))
            'Range("a" & j).Value = i & "\" & MyFileName
            'Range("b" & j).Value = ThisWorkbook.Path & "\照片汇总\" & k & "-" & j & ".jpg"
            Range("a" & j).Value = k & "-" & rowi & ".jpg"
            FileCopy i & "\" & MyFileName, ThisWorkbook.Path & "\照片汇总\" & k & "-" & rowi & ".jpg"
            MyFileName = Dir()
            MyRow = MyRow + 1
        Loop

    Next
    r.Close
    rrr.Close
    Set r = Nothing
    Set rrr = Nothing
End Sub