用拍摄时间来命名照片，改进程序

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

1. Dim index As Integer
2. Private Sub Command1_Click()
3.     Dim filename, newfilename$, newfilenameback$, newfilenamekz$, filedt$, exname$
4.     Dim i%, indexphoto%
5.     Dim photoname$(), attachnum%()
6.     ReDim photoname(1 To File1.ListCount)
7.     ReDim attachnum(1 To File1.ListCount)
8.     For i = 1 To File1.ListCount
9.         attachnum(i) = 1
10.         photoname(i) = ""
11.     Next i
12.     indexphoto = 1
13.     
14.     For i = 0 To File1.ListCount - 1
15.         File1.ListIndex = i
16.         filename = CStr(File1.filename)
17.         exname = Right(filename, 4)
18.         
19.         filedt = FileDateTime("d:\photo\" & filename)
20.         'MsgBox filedt
21.         newfilename = getdtname(filedt)
22.         newfilenamekz = newfilename & exname
23.         newfilenameback = newfilenamekz
24.         '如果有重名的文件，就在文件名后增加一个数字，和重名文件区别开
25.         If ifsamename(photoname(), newfilenamekz) = True Then
26.             newfilenamekz = (newfilename & attachnum(index)) & exname
27.             attachnum(index) = attachnum(index) + 1
28.         Else
29.             photoname(indexphoto) = newfilenameback
30.             indexphoto = indexphoto + 1
31.         End If
32.         
33.         Name "d:\photo\" & filename As "d:\photo\" & newfilenamekz
34.     Next i
35.     MsgBox "OK!"
36. End Sub
37.  
38. Private Sub Form_Load()
39.     File1.Path = "d:\photo\"
40. End Sub
41. Private Function getdtname(dt As String) As String
42.     '文件的创建时间格式为2010-05-13 19:30:23，即为形参dt。
43.     '通过getdtname函数得到以文件创建时间为名字的文件名，格式为20100513193023
44.     Dim dtarray() As String, darray() As String, tarray() As String
45.     If Len(dt) > 0 Then
46.         dtarray() = Split(dt)
47.         'MsgBox dtarray(0)
48.         'MsgBox dtarray(1)
49.         darray() = Split(dtarray(0), "/")
50.         'MsgBox darray(0)
51.         'MsgBox darray(1)
52.         'MsgBox darray(2)
53.         tarray() = Split(dtarray(1), ":")
54.         'MsgBox tarray(0)
55.         'MsgBox tarray(1)
56.         'MsgBox tarray(2)
57.         If Len(darray(1)) = 1 Then darray(1) = 0 & darray(1)
58.         If Len(darray(2)) = 1 Then darray(2) = 0 & darray(2)
59.         If Len(tarray(0)) = 1 Then tarray(0) = 0 & tarray(0)
60.         If Len(tarray(1)) = 1 Then tarray(1) = 0 & tarray(1)
61.         If Len(tarray(2)) = 1 Then tarray(2) = 0 & tarray(2)
62.         getdtname = darray(0) & darray(1) & darray(2) & tarray(0) & tarray(1) & tarray(2)
63.     End If
64.  
65. End Function
66. Private Function ifsamename(name$(), destname As String) As Boolean
67. '判断和destname是否有重名的文件
68.     Dim length As Integer, name_index%
69.     'length = UBound(name()) - LBound(name()) + 1
70.     For name_index = LBound(name()) To UBound(name())
71.         If destname = name(name_index) Then
72.             ifsamename = True
73.             index = name_index
74.             Exit For
75.         Else
76.             ifsamename = False
77.         End If
78.     Next name_index
79.         
80. End Function