Excel VBA批量修改文件夹下的文件名
今天,有同事提出想批量修改文件名,规则比较简单,在第五位后加“-”即可,
上网没找到相关工具,就自己做了个excel,用宏代码修改。
代码如下:
Private Sub CommandButton1_Click()
Dim varFileList As Variant
MsgBox "选择要重命名文件所在的文件夹,点击确定!"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
renamepath = .SelectedItems(1)
If Right(renamepath, 1) <> "\" Then
renamepath = renamepath + "\"
End If
End With
'获取文件夹中的所有文件列表
varFileList = fcnGetFileList(renamepath)
If Not IsArray(varFileList) Then
MsgBox "未找到文件", vbInformation
Exit Sub
End If
For l = 0 To UBound(varFileList)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
oName = renamepath & CStr(varFileList(l))
If fs.FileExists(oName) And Len(CStr(varFileList(l))) > 5 Then
nName = renamepath & Left(CStr(varFileList(l)), 5) & "-" & Mid(CStr(varFileList(l)), 6)
Name oName As nName
End If
Next l
MsgBox "全部修改成功!哈哈", vbInformation
End Sub
Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant
' 将文件列表放到数组
Dim f As String
Dim i As Integer
Dim FileList() As String
If strFilter = "" Then strFilter = "*.*"
Select Case Right(strPath, 1)
Case "\", "/"
strPath = Left(strPath, Len(strPath) - 1)
End Select
ReDim Preserve FileList(0)
f = Dir(strPath & "\" & strFilter)
Do While Len(f) > 0
ReDim Preserve FileList(i) As String
FileList(i) = f
i = i + 1
f = Dir()
Loop
If FileList(0) <> Empty Then
fcnGetFileList = FileList
Else
fcnGetFileList = False
End If
End Function
最新文章
- jquery读取csv文件并用json格式输出
- CGI技术原理
- .net framework缓存遍历
- 修改范围PHP_INI_SYSTEM与PHP_INI_ALL的区别
- Android新浪微博客户端(四)——添加多个账户及认证
- 简单五子棋,没有电脑AI
- JAVA中的枚举类
- 《java入门第一季》之类(String类常见方法小叙)
- .NET Core整理之配置EFCore
- 响应数据传出(springMVC)
- linux select函数详解
- 子类中的成员函数覆盖父类(name hiding)
- webpack4 自学笔记一(babel的配置)
- Oracle 错误总结及问题解决 ORA
- 微信小程序——修改data里面数组某一个值
- Elasticsearch学习之多种查询方式
- 【Codeforces】Codeforces Round #491 (Div. 2) (Contest 991)
- [翻译]API Guides - Bound Services
- JSP 问题总结
- React Native开发之expo中camera的基本使用