这段代码哪里出问题了?
功能:把文件夹内的文件修改时间和文件名合并在一起作为新的文件名
出现的问题是在有的机上能很好的运行,但在一些机子上出现遍历两次的情况(也就是文件名被改了两次,以致于有两个时间)
Sub GetNewFileName()
Dim nchar As Integer
Dim strPathName As String
Dim tFindData As WIN32_FIND_DATA
Dim sFileTime As String
Dim lngresult As Long
Dim lnghandle As Long
Dim closehandle As Long
Dim bll As Boolean
tFindData.cFileName = " " '初始化定长字符串
strPathName = Dir1.Path & "\ " & "*.MPG "
'获取句柄
lnghandle = FindFirstFile(strPathName, tFindData)
closehandle = lnghandle
Do While lnghandle <> INVALID_HANDLE_VALUE '如果获得文件句柄成功
strFileName = sGetCrtFileName(tFindData.cFileName)
sFileTime = Dir1.Path & "\ " & strFileName
lngresult = CreateFile(sFileTime, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lngresult = INVALID_HANDLE_VALUE Then
Exit Sub
End If
'获得文件的时间信息
lngresult = GetFileTime(lngresult, ftCreatetime, ftAccesstime, ftModifyTime)
If lngresult <> 0 Then '如果获得文件时间信息成功
lngresult = FileTimeToLocalFileTime(ftModifyTime, ftlocal)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
'转换本地时间到系统时间
lngresult = FileTimeToSystemTime(ftlocal, ftSystem)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
With ftSystem
sMonth = CStr(.wMonth)
sDay = CStr(.wDay)
sHour = CStr(.wHour)
sMinute = CStr(.wMinute)
If Len(sMonth) = 1 Then
sMonth = "0 " & sMonth
End If
If Len(sDay) = 1 Then
sDay = "0 " & sDay
End If
If Len(sHour) = 1 Then
sHour = "0 " & sHour
End If
If Len(sMinute) = 1 Then
sMinute = "0 " & sMinute
End If
ModifyTime = CStr(.wYear) & ". " & sMonth & ". " & sDay & ". " & sHour & ". " & sMinute
sPrtTime = sHour & ". " & sMinute
End With
End If
End If
End If
If blPrint = True Then
nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
sNewName = Dir1.Path & "\ " & ModifyTime & sOldName & cmbAddress & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
'命名新文件
bll = ReName(0, sOldName, sNewName)
Else
nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
If chkPrtTime.Value Then
sNewName = Dir1.Path & "\ " & sPrtTime & sOldName & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
bll = ReName(0, sOldName, sNewName)
Else
sNewName = sOldName
End If
End If
tFindData.cFileName = " "
If FindNextFile(lnghandle, tFindData) = 0 Then '查询结束或发生错误
Close lngresult
FindClose (closehandle)
Exit Do
End If
Loop
Exit Sub
End Sub
[解决办法]
你的文件改名后，被作为新文件 Find 了。
Sub GetNewFileName()
Dim nchar As Integer
Dim strPathName As String
Dim tFindData As WIN32_FIND_DATA
Dim sFileTime As String
Dim lngresult As Long
Dim lnghandle As Long
Dim closehandle As Long
Dim bll As Boolean
Dim strMyFile() As String, i As Long
tFindData.cFileName = " " '初始化定长字符串
strPathName = Dir1.Path & "\ " & "*.MPG "
'获取句柄
i = 0
lnghandle = FindFirstFile(strPathName, tFindData)
closehandle = lnghandle
Do While lnghandle <> INVALID_HANDLE_VALUE '如果获得文件句柄成功
strFileName = sGetCrtFileName(tFindData.cFileName)
sFileTime = Dir1.Path & "\ " & strFileName
ReDim Preserve strMyFile(i)
strMyFile(i) = sFileTime
tFindData.cFileName = " "
If FindNextFile(lnghandle, tFindData) = 0 Then '查询结束或发生错误
Close lngresult
FindClose (closehandle)
Exit Do
End If
Loop
For i = 0 To Ubound(strMyFile)
lngresult = CreateFile(strMyFile(i), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lngresult = INVALID_HANDLE_VALUE Then
Exit Sub
End If
'获得文件的时间信息
lngresult = GetFileTime(lngresult, ftCreatetime, ftAccesstime, ftModifyTime)
If lngresult <> 0 Then '如果获得文件时间信息成功
lngresult = FileTimeToLocalFileTime(ftModifyTime, ftlocal)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
'转换本地时间到系统时间
lngresult = FileTimeToSystemTime(ftlocal, ftSystem)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
With ftSystem
sMonth = CStr(.wMonth)
sDay = CStr(.wDay)
sHour = CStr(.wHour)
sMinute = CStr(.wMinute)
If Len(sMonth) = 1 Then
sMonth = "0 " & sMonth
End If
If Len(sDay) = 1 Then
sDay = "0 " & sDay
End If
If Len(sHour) = 1 Then
sHour = "0 " & sHour
End If
If Len(sMinute) = 1 Then
sMinute = "0 " & sMinute
End If
ModifyTime = CStr(.wYear) & ". " & sMonth & ". " & sDay & ". " & sHour & ". " & sMinute
sPrtTime = sHour & ". " & sMinute
End With
End If
End If
End If
If blPrint = True Then
nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
sNewName = Dir1.Path & "\ " & ModifyTime & sOldName & cmbAddress & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
'命名新文件
bll = ReName(0, sOldName, sNewName)
Else
nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
If chkPrtTime.Value Then
sNewName = Dir1.Path & "\ " & sPrtTime & sOldName & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
bll = ReName(0, sOldName, sNewName)
Else
sNewName = sOldName
End If
End If
Next i
Exit Sub
End Sub
