以照片的创建时间批量命名该照片,VB程序
'*****************************************************************
'Name:filename.frm
'Desc:使用照片的创建日期和时间,命名该照片
'Parameter:
'Return:
'Author: yoyoba(stuyou@126.com)
'Date: 2010-5-30
'Modify:2010-5-30
'*****************************************************************
'使用该文件的创建日期,重新命名该文件
Private Sub Command1_Click()
Dim filename, newfilename As String, filedt As String, exname As String
Dim i%
For i = 0 To File1.ListCount - 1
File1.ListIndex = i
filename = CStr(File1.filename)
exname = Right(filename, 4)
filedt = FileDateTime("E:\Photos\photo\" & filename)
'MsgBox filedt
newfilename = getdtname(filedt)
newfilename = newfilename & exname
Name "E:\Photos\photo\" & filename As "E:\Photos\photo\" & newfilename
Next i
End Sub
Private Sub Form_Load()
File1.Path = "E:\Photos\photo\"
End Sub
Private Function getdtname(dt As String) As String
'文件的创建时间格式为2010-05-13 19:30:23,即为形参dt。
'通过getdtname函数得到以文件创建时间为名字的文件名,格式为20100513193023
Dim dtarray() As String, darray() As String, tarray() As String
If Len(dt) > 0 Then
dtarray() = Split(dt)
'MsgBox dtarray(0)
'MsgBox dtarray(1)
darray() = Split(dtarray(0), "-")
'MsgBox darray(0)
'MsgBox darray(1)
'MsgBox darray(2)
tarray() = Split(dtarray(1), ":")
'MsgBox tarray(0)
'MsgBox tarray(1)
'MsgBox tarray(2)
If Len(darray(1)) = 1 Then darray(1) = 0 & darray(1)
If Len(darray(2)) = 1 Then darray(2) = 0 & darray(2)
If Len(tarray(0)) = 1 Then tarray(0) = 0 & tarray(0)
If Len(tarray(1)) = 1 Then tarray(1) = 0 & tarray(1)
If Len(tarray(2)) = 1 Then tarray(2) = 0 & tarray(2)
getdtname = darray(0) & darray(1) & darray(2) & tarray(0) & tarray(1) & tarray(2)
End If
End Function