标题: 使用VBA创建文件夹及命名文件 [打印本页] 作者: etthink 时间: 2021-12-6 07:24 标题: 使用VBA创建文件夹及命名文件 代码：
Dim n As Integer, k As Integer
Dim fs, f, fL, fc
Const strPath = "C:\temp", strPath1 = strPath & "\"
Dim fd As FileDialog
Function OpenCopyFiles() '浏览、选择、拷贝、重命名文件。
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject") '创建FSO对象
If fs.FolderExists(strPath) = False Then '检查 "C:\temp"是否存在,若不存在，则创建，并执行myHandle后的语句；反之，则直接执行后面的语句
fs.CreateFolder (strPath)
GoTo myHandle
Else
GoTo myHandle
End If
myHandle:
Set fd = Application.FileDialog(msoFileDialogOpen) '创建打开文件对话框
With fd
.Title = "选择文件"
.AllowMultiSelect = True '允许多选
If .Show = True Then
For Each fL In .SelectedItems
fs.CopyFile fL, strPath1 '拷贝选择的文件到C:\temp"文件夹下
Next
End If
End With
End Function
Sub ReNameFiles()
On Error Resume Next
Call OpenCopyFiles
Set f = fs.getFolder(strPath)
Set fc = f.Files
k = fc.Count
n = 0
For Each fL In fc '对已考入到C:\temp"文件夹下的文件进行序号命名
s = InStr(1, fL.Name, ".") '判断文件名中"."字符的位置
sufix = Mid(fL.Name, s) '获取".*"扩展名的字符串
n = n + 1
fL.Name = n & sufix
If n > k Then End
Next
MsgBox "重命名完毕,请到" & strPath & "文件夹下查看结果", vbOKOnly, "提醒"
End Sub