问题
I've got lots of files in a folder structered with names like:
"prof102122013@10.18.41.csv"
where the "02122013" bit is the date - 02/12/2013. Some of them have been made on the same day. I'd like to create a file that takes all of the workbooks that were made on the same day and put them all in one big file. So far I am struggling to get the selectivity to open a day-specific file. Does anyone have any idea what kind of code can help me with this?
Edit: Solved, thanks for the help, all! Here was the code that worked for me:
folder_location = Application.ActiveWorkbook.Path
i2 = 0
strFile = Dir(folder_location & "\")
'looping through to find the right file names and putting them all in an array
While strFile <> ""
If Right(strFile, 3) = "csv" Then
file_to_analyse = Split(strFile, "@")
If Right(file_to_analyse(0), 8) = date_we_want_to_analyse_on Then
found_files_to_analyse(i2) = strFile
i2 = i2 + 1
End If
End If
strFile = Dir
Wend
回答1:
Do you want to consolidate files on the basis of file saved date or on the basis of the name of the file. A file named with yesterday's date can be saved today and will bear today's date. I guess you would have to parse the name of the file and apply logic around the date (in the file name) in a do while loop till all the files in the directory are searched for the condition. If the condition is met, you copy the opened file into a worksheet in your file. If the condition is not met, the file is skipped. Following might help
For each date which needs to be consolidated, do the following in a loop or an in a user prompted message box where the user inputs the date. You also need to chose whether you want the consolidation to happen in the workbook from where you are launching the macro or a separately opened workbook. The code below assumes you are consolidating in the same workbook.
Path = Path of the directory in which the files are stored
Flname = Dir(Path & "*.csv")
Do While Flname <> ""
If ' file check Condition' Then
Filecheckname = True ' Checks if file follows the naming conventions desired
Else
Filecheckname = False
End If
If Filecheckname Then
FlDate = getDate(Flname) ' extracts the date from the file name
Else
GoTo Errorhandler ' If there is an error, then the macro stops with a message to the user
End If
If FlDate<> Date Then
flsskpd = flsskpd + 1 ' If the date criteria is not met, the file is skipped with an increment to the fileskipped counter
Flname = Dir()
Else
Workbooks.Open Filename:=Path & Flname, ReadOnly:=True
'Code to Copy into consolidated workbook (ThisWorkbook)
filesmoved = filesmoved + 1
Flname = Dir()
End if
Loop
Message to user about how many files skipped and consolidated.
Prompt user whether to continue to the next date consolidation, if yes, continue or take the new date as an input and repeat the loop
回答2:
If you want VBA to "search" for a file/folder in a directory, I think you need to use something like this:
Option Explicit
Option Compare Text
Public Enum xlSearchMode
xlFilesOnly = 0
xlFoldersOnly = 1
xlFilesAndFolders = 2
End Enum
Function SearchInDirectory(FName As String, Optional FoName As String, Optional SearchMode As xlSearchMode = xlFilesOnly, Optional ExactMatch As Boolean = True) As Variant
'By Abdallah Khaled Ali El-Yaddak
'Returns an array of strings with files/folders matching what you are searching for.
'If nothing is found, it returns an array of one empty string element.
'-------------'
'FName (String): The file/folder to look for
'[FoName] (String): The directory to search in, if omitted, CurDir will be used.
'[SreachMode] (xlSearchMode): xlFilesOnly (default) = Look for files only | xlFoldersOnly = Look for folders only | xlFilesAndFolders = Look for both
'[Exactmatch] (Boolean): True (default) = Look only for this string (case insenstive) | False = Sreach for any files/folders that includes this string in their name
Dim FSO As Object, File As Object, Folder As Object, Fnames() As String, i As Long, SubNames As Variant, SubFolder As Object
If FoName = "" Then FoName = CurDir
If Right(FoName, 1) <> "\" Then FoName = FoName & "\"
ReDim Fnames(1 To 1) As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(FoName)
If SearchMode = xlFilesOnly Or SearchMode = xlFilesAndFolders Then
For Each File In FSO.GetFolder(Folder).Files
If (ExactMatch And SubFolder.Name = FName) Or _
(Not ExactMatch And SubFolder.Name Like "*" & FName & "*") Then
Fnames(UBound(Fnames)) = File.Path
ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
End If
Next
End If
If SearchMode = xlFoldersOnly Or SearchMode = xlFilesAndFolders Then
For Each SubFolder In FSO.GetFolder(Folder).subFolders
If (ExactMatch And SubFolder.Name = FName) Or _
(Not ExactMatch And SubFolder.Name Like "*" & FName & "*") Then
Fnames(UBound(Fnames)) = SubFolder.Path
ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
End If
Next
End If
For Each SubFolder In FSO.GetFolder(Folder).subFolders
SubNames = SearchInDirectory(FName, SubFolder.Path, SearchMode, ExactMatch)
If SubNames(LBound(SubNames)) <> "" Then
For i = LBound(SubNames) To UBound(SubNames)
Fnames(UBound(Fnames)) = SubNames(i)
ReDim Preserve Fnames(1 To UBound(Fnames) + 1)
Next
End If
Next
If UBound(Fnames) > 1 Then ReDim Preserve Fnames(1 To UBound(Fnames) - 1)
SearchInDirectory = Fnames
End Function
To test, you need something like this:
Sub Test()
Dim a As Variant, i As Long
a = SearchInDirectory(date_we_want_to_analyse_on, folder_location, xlFilesOnly, Flase)
For i = LBound(a) To UBound(a)
Debug.Print a(i)
Next
End Sub
Notes:
- This solution doesn't work on MAC (tested only on windows)
- Searching will take longer for larger directories (The number of files/folders inside)
来源：https://stackoverflow.com/questions/20885129/vba-search-through-a-folder-and-select-files-by-name