以照片的创建时间批量命名该照片，VB程序

 

'*****************************************************************
'Name:filename.frm
'Desc:使用照片的创建日期和时间，命名该照片
'Parameter:
'Return:
'Author: yoyoba([e-mail])
'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