批量命名的软件很多,ACDSee photo等都能实现,但是大多都是简单的文字+数字命名,局限就出来了
本人则喜欢用vba来实现
Sub 批量命名0()
Application.ScreenUpdating = False
Dim i&, j&, m, n, l$, k, s, path, oname, nname, fs, t$
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True '允许多选
.Show '打开文件对话框
' 获取文件名称,名称会都显示在工作表的A列
For i = 1 To .SelectedItems.Count
l = .SelectedItems(i)
m = Len(l) - Len(WorksheetFunction.Substitute(l, "\", ""))
k = WorksheetFunction.Substitute(l, "\", "/", m)
n = WorksheetFunction.Find("/", k)
Cells(i, 1) = Mid(l, n + 1, Len(l))
' 获取文件路径
If i = .SelectedItems.Count Then path = Mid(l, 1, Len(l) - Len(Cells(i, 1)))
Next i
End With
' 获取新名字 按自然数编号,适用于大多数人的需要
t = "0000" '命名文件一般数百上千,超过百万的应该没有吧,有的话,excel2010最多也就100
' 多万行,这里也不适用
If i <= 1000 Then t = "000"
If i <= 100 Then t = "00"
If i <= 10 Then t = "0"
For s = 1 To i - 1
l = Cells(s, 1).Value
m = Len(l) - Len(WorksheetFunction.Substitute(l, ".", ""))
k = WorksheetFunction.Substitute(l, ".", "/", m)
n = WorksheetFunction.Find("/", k)
Cells(s, 2) = WorksheetFunction.text(s, t) & Mid(l, n, Len(l))
Next
Stop
' 修改文件名 修改前stop暂停,如果不喜自然数名称,可以对B列的名称做修改,单个修改都行
Set fs = CreateObject("Scripting.FileSystemObject")
For s = 1 To i - 1
oname = path & Cells(s, 1)
If fs.fileexists(oname) Then
nname = path & Cells(s, 2)
Name oname As nname
End If
Next
Application.ScreenUpdating = True
End Sub