修改一个文件夹下所有的Excel文件的名字为该Excel文件里某个表格里面的文本

http://tieba.baidu.com/p/2954798276

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

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

VBA程序代工，点名字查邮箱。