vba 搜索文件夹并按名称选择文件

问题描述 投票:0回答:3

我的文件夹中有很多文件,其名称如下:

[电子邮件受保护]

其中“02122013”位是日期 - 02/12/2013。其中一些是在同一天制作的。我想创建一个文件,将同一天制作的所有工作簿放入一个大文件中。到目前为止,我正在努力获得打开特定日期文件的选择性。有谁知道什么样的代码可以帮助我解决这个问题?

编辑:已解决,感谢大家的帮助!这是对我有用的代码:

 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
file vba selection
3个回答
0
投票

您要根据文件保存日期还是根据文件名来合并文件。以昨天的日期命名的文件可以在今天保存并带有今天的日期。我想您必须解析文件名并在 do while 循环中应用围绕日期(文件名中)的逻辑,直到搜索目录中的所有文件以查找条件。如果满足条件,则将打开的文件复制到文件中的工作表中。如果不满足条件,则跳过该文件。以下可能有帮助

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

0
投票

如果你希望VBA“搜索”目录中的文件/文件夹,我认为你需要使用这样的东西:

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

要进行测试,您需要这样的东西:

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

备注:

  1. 此解决方案不适用于 MAC(仅在 Windows 上测试)
  2. 对于较大的目录,搜索将花费更长的时间(其中的文件/文件夹的数量)

0
投票

我在 Excel 电子表格的 A 列中输入了一个文件名列表。实际文件位于文件夹 c 中

© www.soinside.com 2019 - 2024. All rights reserved.