VBA-通过名称标识符查找特定的子文件夹

时间:2019-03-15 07:04:16

标签: excel vba

标题可能需要进行调整,因为它可能会出现重复的问题。

对于这个冗长的问题,我深表歉意。

借助这些链接:

https://www.ozgrid.com/forum/forum/help-forums/excel-general/83263-search-for-file-with-wildcards-and-partial-filename

VBA macro that search for file in multiple subfolders

VBA search for a specific subfolder in many folders and move all the files in it

我有以下代码:

Public Sub grab_Folder_Name()

    Dim todayDate As String, yesterdayDate As String, folderTime As String, startTime As String, endTime As String
    Dim basePath As String, fileName As String
    Dim parentFolder As Folder, subFolder1 As Folder, subFolder2 As Folder
    Dim myDateArray As Variant
    Dim fsoFileSystem As New FileSystemObject
    Dim tmpltWkbk As Workbook
    Dim kwArray As Variant, sTime As Variant, eTime As Variant
    Dim ws1 As Worksheet
    Dim i As Long, r As Range

    'Set dates to look between
    todayDate = Format(DateAdd("d", 0, Date), "dd_mm_YYYY")
    yesterdayDate = Format(DateAdd("d", -1, Date), "dd_mm_YYYY")

    'Set workbook to work with
    Set tmpltWkbk = Workbooks("Template.xlsm")

    'Set sheet to work with
    Set ws1 = tmpltWkbk.Sheets("Run Results")

    'Set default time structure in variable
    folderTime = "##.##.##"

    'Set date array
    myDateArray = Array(todayDate, yesterdayDate)

    'Set time Array for Start Time
    sTime = Array("18:00:00", "00:00:00")

    'Set time Array for End Time
    eTime = Array("11:59:00", "06:00:00")

    'Get the range to use
    Set rng = find_Header("KW ID", "Array")

    'Print out array values
    'Just for my debugging
    ReDim arr(1 To rng.count)

    i = 1

    For Each r In rng

        arr(i) = r.Value
        i = i + 1

    Next r

    kwArray = arr

    For i = LBound(kwArray) To UBound(kwArray)

        Debug.Print kwArray(i)

    Next

    'Get the path of the parent folder
    basePath = "\\path"

    'Set the parent folder
    Set parentFolder = fsoFileSystem.GetFolder(basePath)

    'Check if the path contains a \ at the end, if not then add it
    If Right(basePath, 1) <> "\" Then basePath = basePath & "\"

    'Set the directory in a variable
    fileName = Dir(basePath, vbDirectory)

    'Looop through all the KW
    For Each kwID In kwArray

        'Loop through all the dates
        For Each myDate In myDateArray

            'Loop through all the first set of subfolders
            For Each subFolder1 In parentFolder.SubFolders

                Debug.Print subFolder1.Name
                Debug.Print myDate

                If subFolder1.Name Like Not "########_##-##-##_##.##.##" Then

                    'Don't know what to do - Do nothing?

                Else

                '********** This never seems to be a match **********

                    'Check if the subFolder1 matches the format
                    If subFolder1.Name = "########_" & myDate & "_" & folderTime Then

                        If myDate = todayDate Then

                            startTime = sTime(1)
                            endTime = eTime(1)

                        ElseIf myDate = yesterdayDate Then

                            startTime = sTime(2)
                            endTime = eTime(2)

                        End If

                        'Check if the subFolder1 is between the times specified
                        If subFolder1.DateCreated > startTime And subFolder1.DateCreated < endTime Then

                            'Loop through all the second set of subfolders
                            For Each subFolder2 In subFolder1.SubFolders

                                'Check if the subFolder2 matches the format
                                If subFolder2.Name = "#########_" & kwID & "_" & folderTime Then

                                    With ws1

                                        '.Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)

                                        'Grab the hyperlink
                                        'Address:=subFolder1.path
                                        '.FollowHyperlink subFolder1.path

                                        'Nothing happens here - The If Condition is not met
                                        Debug.Print subFolder1.Name

                                    End With

                                End If

                            Next subFolder2

                        End If

                    End If

                End If

                'This one prints all the folder names in this folder
                Debug.Print subFolder1.Name

            Next subFolder1

        Next myDate

    Next kwID

End Sub

以下是我需要和仍然需要做的事情的细分:

  1. 根据数据表中的范围创建一个KW ID号数组
  2. 导航到基本文件夹的文件夹路径
  3. 循环浏览每个子文件夹,以查找以下文件夹名称结构: MachineName_Date_Time -> Date(YYYY / MM / DD),Time(HH:MM: SS)
  4. 唯一相关的日期是今天前一天
  5. 唯一相关的时间是今天(00:00:01-> 06:30:00)昨天(18:00:00-> 00:00 :00)
  6. 如果找到与上述结构匹配的文件夹,那么我需要进入该文件夹并遍历那些子文件夹以寻找其他文件夹名称结构
  7. 第二个文件夹名称为: MachineName_KWID_Time
  8. 使用此文件夹名称,唯一相关的是 KWID ,它必须与数组中存储的KW ID之一匹配。

我提供的代码一直到第8步-到目前为止,第9到12步我还没有任何东西

  1. 如果找到匹配项,我需要输入该文件夹并查看其中的文件
  2. 我要查找的唯一文件是具有 PNG扩展名
  3. 的图像文件
  4. 如果文件夹中有一个图像文件,我需要获取该图像文件的名称,并将该名称与KWID值一起放在我的工作簿的一个单元格中
  5. 完成所有这些操作后,我需要创建一个指向该文件夹(包含图像的文件夹)的超链接,并将超链接设置为我的工作簿中的KWID单元格。

这是我遇到的问题:

  1. 第一个子文件夹始终似乎是 MachineName_12-03-2019_08.20.42 。在此之前和之后都有文件夹,但始终是这个文件夹
  2. 在文件夹中循环浏览时,它会发现比12-03-2019更新的日期,但似乎并不是从最新创建的日期开始向下搜索
  3. myDate变量返回今天的日期-15/03/2019-所以我知道这是在寻找正确的日期
  4. 我不确定应该执行哪些验证来检查子文件夹名称是否与所需的“格式”匹配。目录中可能存在与所需文件夹名称格式不匹配的文件或文件夹
  5. 因为我无法通过以下if语句:If subFolder1.Name = "########_" & myDate & "_" & folderTime Then,所以我无法测试其后发生的事情
  6. 我已注释掉获取超链接的代码,因为我不确定它是否正确,并且在此行.Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)上出现错误
  

参数不是可选的

如果我能够解决遇到的问题,那么我可以继续完成剩余的任务并添加到代码中。

0 个答案:

没有答案