By

用手机拍的照片，由于生成文件的时间没有秒，因此使用以前写的程序来批量命名照片的时候，会产生照片名已存在的错误，为了解决这个问题，重新改写了这个程序。

Dim index As Integer
Private Sub Command1_Click()
    Dim filename, newfilename$, newfilenameback$, newfilenamekz$, filedt$, exname$
    Dim i%, indexphoto%
    Dim photoname$(), attachnum%()
    ReDim photoname(1 To File1.ListCount)
    ReDim attachnum(1 To File1.ListCount)
    For i = 1 To File1.ListCount
        attachnum(i) = 1
        photoname(i) = ""
    Next i
    indexphoto = 1
    
    For i = 0 To File1.ListCount - 1
        File1.ListIndex = i
        filename = CStr(File1.filename)
        exname = Right(filename, 4)
        
        filedt = FileDateTime("d:\photo\" & filename)
        'MsgBox filedt
        newfilename = getdtname(filedt)
        newfilenamekz = newfilename & exname
        newfilenameback = newfilenamekz
        '如果有重名的文件，就在文件名后增加一个数字，和重名文件区别开
        If ifsamename(photoname(), newfilenamekz) = True Then
            newfilenamekz = (newfilename & attachnum(index)) & exname
            attachnum(index) = attachnum(index) + 1
        Else
            photoname(indexphoto) = newfilenameback
            indexphoto = indexphoto + 1
        End If
        
        Name "d:\photo\" & filename As "d:\photo\" & newfilenamekz
    Next i
    MsgBox "OK!"
End Sub

Private Sub Form_Load()
    File1.Path = "d:\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
Private Function ifsamename(name$(), destname As String) As Boolean
'判断和destname是否有重名的文件
    Dim length As Integer, name_index%
    'length = UBound(name()) - LBound(name()) + 1
    For name_index = LBound(name()) To UBound(name())
        If destname = name(name_index) Then
            ifsamename = True
            index = name_index
            Exit For
        Else
            ifsamename = False
        End If
    Next name_index
        
End Function