原理：

1）先檢查c盤根目錄下是否有TEMP文件夾，若無，則創(chuàng)建之，并將所選文件拷貝到該文件下；若有，則直接拷貝所選文件

2）重命名文件

提醒：運(yùn)行完本程序后請到C:\temp下查看結(jié)果。 

代碼：

Dim fs, f, fc, fL

Const strPath = "C:\temp\"

Function OpenCopyFiles()    '瀏覽、選擇、拷貝文件。

    Dim fd As FileDialog

    Set fs = CreateObject("Scripting.FileSystemObject")    '創(chuàng)建FSO對象

    If fs.FolderExists(strPath) = False Then fs.CreateFolder (strPath)    '檢查 "C:\temp"是否存在,若不存在，則創(chuàng)建

    Set fd = Application.FileDialog(msoFileDialogOpen)    '創(chuàng)建打開文件對話框

    With fd

        .Title = "選擇文件"

        .Filters.Clear

        .Filters.Add "圖片文件", "*.bmp;*.jpg;*.png;*.jpeg;*.wmf;*.emf"

        .AllowMultiSelect = True    '允許多選

        .Show

        For Each fL In .SelectedItems

            fs.CopyFile fL, strPath    '拷貝選擇的文件到C:\temp\下

        Next

    End With

End Function

Function ReNameFiles()    '重命名文件。

    Dim m As Integer, k As Integer

    On Error Resume Next

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.getFolder(strPath)

    Set fc = f.Files

    k = fc.Count

    For Each fL In fc    '對已考入到C:\temp"文件夾下的文件進(jìn)行序號命名

        s = InStr(1, fL.Name, ".")    '判斷文件名中"."字符的位置

        extName = Mid(fL.Name, s)    '獲取".*"擴(kuò)展名的字符串

        fL.Name = IIf(k < 10, "pic0", "pic") & k & extName    '100內(nèi)

        k = k - 1

        If k < 1 Then Exit For

    Next

    Set fs = Nothing

End Function

Sub test()

    Call OpenCopyFiles

    Call ReNameFiles

    MsgBox "重命名完畢,請到" & strPath & "文件夾下查看結(jié)果", vbOKOnly, "提醒"

End Sub