如何用FindFirstFile和FindNextFile对一个文件夹内的文件进行遍历
我想用这两个函数对一个文件夹内的所有文件名全部改为文件的创建时间+原来的文件名作为新文件名.
为什么在有的机子上能正常修改,但在有的机上却重命名多次(就是出现好几个创建时间)
[解决办法]
Private Sub Form_Load()
On Error GoTo Hell
Dim sSearchPath As String, sExtensionList As String
Dim taFiles As mctFileSearchResults
Dim x As Long
Me.Show
DoEvents
Screen.MousePointer = vbHourglass
sSearchPath = "C:\windows\system32 "
sExtensionList = "*.* " ' "*.txt;*.exe "
FileSearchA sSearchPath, sExtensionList, taFiles, False
If taFiles.FileCount > 0 Then
With Listview
.View = lvwReport
.Move 60, 60, 10995, 3435
With .ColumnHeaders
.Add , , "Filename ", 1560
.Add , , "Extension ", 900
.Add , , "Path ", 1904
.Add , , "Size ", 989
.Add , , "Read-Only ", 945
.Add , , "UNC Path ", 2910
.Add , , "Creation Date ", 1440
End With
Me.Move Me.Left, Me.Top, .Width + 240, .Height + 520
End With
For x = 1 To UBound(taFiles.Files)
With Listview.ListItems.Add(, , taFiles.Files(x).FileName)
.SubItems(1) = taFiles.Files(x).Extension
.SubItems(2) = taFiles.Files(x).FilePath
.SubItems(3) = FormatNumber(taFiles.Files(x).Size, 0)
.SubItems(4) = IIf(taFiles.Files(x).ReadOnly, "Yes ", " ")
.SubItems(5) = taFiles.Files(x).UNC
.SubItems(6) = taFiles.Files(x).CreationDate
End With
Next
With Listview.ListItems.Add(, , "Totals ")
.SubItems(5) = taFiles.FileCount & " Files "
.SubItems(3) = Format$(taFiles.FileSize, "###,###,###,##0 ") & " Bytes "
End With
End If
Screen.MousePointer = vbDefault
Exit Sub
Hell:
Debug.Print Err.Description: Stop: Resume
End Sub
bas Code:
Public Sub FileSearchA(ByVal sPath As String, ByVal sFileMask As String, ByRef taFiles As mctFileSearchResults, _
Optional ByVal bRecursive As Boolean = False, Optional ByVal iRecursionLevel As Long = -1)
On Error GoTo Hell
Dim sFilename As String
Dim sFolder As String
Dim iFolderCount As Long
Dim aFolders() As String
Dim aFileMask() As String
Dim iSearchHandle As Long
Dim WFD As WIN32_FIND_DATA
Dim bContinue As Long: bContinue = True
Dim Ret As Long, x As Long
Dim tSystemTime As SYSTEMTIME
If Right(sPath, 1) <> "\ " Then sPath = sPath & "\ "
' Search for subdirectories first and save 'em for later
' --------------------------
If bRecursive Then
iSearchHandle = FindFirstFile(sPath & "*.* ", WFD)
If iSearchHandle <> INVALID_HANDLE_VALUE Then
Do While bContinue
If (InStr(WFD.cFileName, Chr(0)) > 0) Then WFD.cFileName = Left(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
sFolder = Trim$(WFD.cFileName)
If (sFolder <> ". ") And (sFolder <> ".. ") Then ' Ignore the current and encompassing directories
If WFD.dwFileAttributes And vbDirectory Then
iFolderCount = iFolderCount + 1
ReDim Preserve aFolders(iFolderCount)
aFolders(iFolderCount) = sFolder
End If
End If
bContinue = FindNextFile(iSearchHandle, WFD) 'Get next subdirectory.
Loop
bContinue = FindClose(iSearchHandle)
End If
End If
bContinue = True
' Walk through this directory and sum file sizes.
' FindFirstFile takes one type at a time, so we 'll loop the search for as many extensions as specified
aFileMask = Split(sFileMask, "; ")
For x = 0 To UBound(aFileMask)
' Make sure it 's all formatted
If Left$(aFileMask(x), 1) = ". " Then
aFileMask(x) = "* " & aFileMask(x)
ElseIf Left$(aFileMask(x), 2) <> "*. " Then
aFileMask(x) = "*. " & aFileMask(x)
End If
iSearchHandle = FindFirstFile(sPath & aFileMask(x), WFD)
If iSearchHandle <> INVALID_HANDLE_VALUE Then
Do While bContinue
If (InStr(WFD.cFileName, Chr(0)) > 0) Then WFD.cFileName = Left(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
sFilename = Trim$(WFD.cFileName)
' It 's a file, right?
If (sFilename <> ". ") And (sFilename <> ".. ") And (Not (WFD.dwFileAttributes And vbDirectory) = vbDirectory) Then
With taFiles
.FileSize = .FileSize + GetFileSize_(WFD.nFileSizeHigh, WFD.nFileSizeLow)
.FileCount = .FileCount + 1
ReDim Preserve .Files(.FileCount)
With .Files(.FileCount)
.Extension = Mid$(sFilename, InStrRev(sFilename, ". ") + 1)
.FileName = sFilename
.FilePath = sPath
.ReadOnly = (WFD.dwFileAttributes And vbReadOnly) = vbReadOnly
.Size = GetFileSize_(WFD.nFileSizeHigh, WFD.nFileSizeLow)
.UNC = sPath & sFilename
If FileTimeToSystemTime(WFD.ftCreationTime, tSystemTime) Then .CreationDate = tSystemTime.wMonth & "/ " & tSystemTime.wDay & "/ " & tSystemTime.wYear & " " & IIf(tSystemTime.wHour > 12, tSystemTime.wHour - 12 & ": " & tSystemTime.wMinute & " PM ", tSystemTime.wHour & ": " & tSystemTime.wMinute & " AM ")
End With
End With
End If
bContinue = FindNextFile(iSearchHandle, WFD) ' Get next file
Loop
bContinue = FindClose(iSearchHandle)
End If
Next
' If there are sub-directories,
If iFolderCount > 0 Then
' And if we care,
If bRecursive Then
If iRecursionLevel <> 0 Then ' Recursively walk into them...
iRecursionLevel = iRecursionLevel - 1
For x = 1 To iFolderCount
FileSearchA sPath & aFolders(x) & "\ ", sFileMask, taFiles, bRecursive, iRecursionLevel
Next x
End If
End If
End If
Exit Sub
Hell:
Debug.Print Err.Description: Stop: Resume
End Sub
Private Function GetFileSize_(ByVal iFileSizeHigh As Currency, ByVal iFileSizeLow As Currency) As Currency
GetFileSize_ = iFileSizeLow
If iFileSizeLow < 0 Then GetFileSize_ = GetFileSize_ + 4294967296@
If iFileSizeHigh > 0 Then GetFileSize_ = GetFileSize_ + (iFileSizeHigh * 4294967296@)
End Function