原理：
1）先检查c盘根目录下是否有TEMP文件夹，若无，则创建之，并将所选文件拷贝到该文件下；若有，则直接拷贝所选文件
2）重命名文件
提醒：运行完本程序后请到C:\temp下查看结果。
代码：
Dim fs, f, fc, fL
Const strPath = "C:\temp\"
Function OpenCopyFiles() '浏览、选择、拷贝文件。
Dim fd As FileDialog
Set fs = CreateObject("Scripting.FileSystemObject") '创建FSO对象
If fs.FolderExists(strPath) = False Then fs.CreateFolder (strPath) '检查 "C:\temp"是否存在,若不存在，则创建
Set fd = Application.FileDialog(msoFileDialogOpen) '创建打开文件对话框
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"文件夹下的文件进行序号命名
s = InStr(1, fL.Name, ".") '判断文件名中"."字符的位置
extName = Mid(fL.Name, s) '获取".*"扩展名的字符串
fL.Name = IIf(k < 10, "pic0", "pic") & k & extName '100内
k = k - 1
If k < 1 Then Exit For
Next
Set fs = Nothing
End Function
Sub test()
Call OpenCopyFiles
Call ReNameFiles
MsgBox "重命名完毕,请到" & strPath & "文件夹下查看结果", vbOKOnly, "提醒"
End Sub
