VB批量重命名文件，高手进来！！！

Question

一个目录下所有的文件都是后缀为.amr的文件，用每一个文件的最后修改时间，作为文件名进行批量重命名操作。用VB代码实现。
比如123.amr的属性显示修改日期为：2009年4月2日, 20:26:00，要求格式化为2009年4月2日_20时26分00秒_.amr
答案满意再追加5分！
TO：jesuspig
忘记了一点，将文件名更改为文件的修改日期 + 原文件名.amr
如果原文件为123.amr，修改日期为：2009年4月2日, 20:26:00，要求格式化为2009年04月02日_20时26分00秒_123.amr
1月格式化为01月，2月格式化为02月，4日格式化为04日。
一定追加分！

Answer 1

不好意思，第一次没有看清你的问题。
---------------------------------
Private Sub Command1_Click()
Dim fStr As String
Dim tDate As String
Dim pathStr As String
pathStr = App.Path
fStr = Dir(pathStr & "\*.amr")
Do While fStr <> ""
tDate = FileDateTime(fStr)
tDate = Format(tDate, "yyyy年m月d日_hh时mm分ss秒_") & ".amr"
Name fStr As pathStr & "\" & tDate
fStr = Dir
Loop
End Sub
'pathStr是文件的路径
--------------补充回答你补充提出的问题-------------------
fStr返回的就是后缀为.amr的原文件名,日月想用双位表示，也只需小改一下,
因此:

将
tDate = Format(tDate, "yyyy年m月d日_hh时mm分ss秒_") & ".amr"

改为:
tDate = Format(tDate, "yyyy年mm月dd日_hh时mm分ss秒_") & fStr

Answer 2

VB不会，其他的方法，倒是知道很多，看来帮不上你忙啦

Answer 3

'tonkeys qq:58507961
'功能：将文件名更改为文件的修改日期
'2009.4.4
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Const OFS_MAXPATHNAME = 128
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Function GetFileChangeDate(ByVal OldFileName As String) As Date
'函数，取得文件的修改日期
Dim fTime(0 To 2) As FILETIME
Dim sTime As SYSTEMTIME
Dim RET As OFSTRUCT
A = OpenFile(OldFileName, RET, 1) '打开文件
b = GetFileTime(A, fTime(0), fTime(1), fTime(2)) '取时间
FileTimeToSystemTime fTime(1), sTime '转换为系统时间
GetFileChangeDate = CDate(sTime.wYear & "-" & sTime.wMonth & "-" & sTime.wDay & " " & sTime.wHour & ":" & sTime.wMinute & ":" & sTime.wSecond)
CloseHandle A '关闭文件
End Function

Private Sub Command1_Click()
File1.Pattern = "*.amr"
File1.Path = "x:\Test" '文件所在目录
filepath = IIf(Right(File1.Path, 1) = "\", File1.Path, File1.Path & "\") '文件所在路径
For i = 0 To File1.ListCount - 1 '遍历文件
oldfile = filepath & File1.List(i) '带路径的旧文件名
newfile = filepath & Format(GetFileChangeDate(oldfile), "yyyy年m月d日_hh时nn分ss秒_") & ".AMR '带路径的新文件名"
FileCopy oldfile, newfile '更名
Kill oldfile '删除原文件 ,理论上可以用Name oldfile as newfile 代替这两行
Next i
End Sub