ExcelVBA工作中用到的重命名工具

'获取文件按钮，先取得文件的路径与文件名存入字典，再输入到工作表中
Sub 多选文件得路径存入字典()
Dim i As Integer, Fso As Object, ff As Object, mydic As Object
Dim strfiel
Set Fso = CreateObject("Scripting.FileSystemObject")
Set mydic = CreateObject("Scripting.Dictionary")
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .InitialFileName = ThisWorkbook.Path
    If .Show = -1 Then
        For i = 1 To .SelectedItems.Count
            Set ff = Fso.GetFile(.SelectedItems(i))
            mydic(mydic.Count) = Array(i, ff.ParentFolder & "\", ff.Name)
        Next i
    Else
        MsgBox "你取消了": Exit Sub
    End If
End With
With Worksheets("重命名")
    .Range("A3:E" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For j = 0 To UBound(mydic.keys)
        in_row = j + 3
        .Range("a" & in_row).Resize(1, 3) = mydic(j)
    Next j
End With
End Sub
'重命名按钮
Sub 批量重命名()
    t = Timer
    With Worksheets("重命名")
    On Error Resume Next
    hh = .Range("A65536").End(xlUp).Row
    For i = 3 To hh
        y_name = .Cells(i, 2) + .Cells(i, 3).Value
        x_name = .Cells(i, 2) + .Cells(i, 4).Value
        Name y_name As x_name
    Next
    End With
    MsgBox "完成，用时：" & Timer - t
    On Error GoTo 0
End Sub