VBA - Find Specific Sub Folders by Name Identifier

2019-08-18 01:41发布

The heading may need to be adjusted as it might come across as a duplicate question.

I do apologize for the long winded question.

With the help of these links:

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

I have the code below:

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

Here is a breakdown of what it is I require and what I still need to do:

  1. Create an array of KW ID numbers from a range in the data sheet
  2. Navigate to a folder path for the base folder
  3. Loop through each of the sub-folders looking for the folder name structure that will be: MachineName_Date_Time --> Date(YYYY/MM/DD), Time(HH:MM:SS)
  4. The only dates that are relevant are today and the previous day
  5. The only times that are relevant are Today(00:00:01 --> 06:30:00), Yesterday(18:00:00 --> 00:00:00)
  6. If a folder is found matching the above structure, then I need to go into that folder and loop through those sub folders looking for another folder name structure
  7. The second folder name will be: MachineName_KWID_Time
  8. With this folder name, the only relevant thing is the KWID, which needs to be match for one of the KW ID's stored in the array

The code I am providing so goes up until step 8 - I don't have anything for step 9 - 12 as of yet

  1. If a match is found, I need to then enter that folder and look at the files within
  2. The only file I am looking for, is an image file with PNG extension
  3. If there is an image file in the folder, I need to grab the name of the image file and place that name in a cell in my workbook alongside the KWID value
  4. Once all of this is done, I need to create a hyperlink to this folder - the folder that contains the image - and set the hyperlink to the KWID cell in my workbook

Here are my issues I am experiencing:

  1. The first sub-folder always seems to be MachineName_12-03-2019_08.20.42. There are folders after and before this one, but this one is ALWAYS first
  2. While looping through the folders, it will find dates newer than 12-03-2019, but it does not seem to be searching from latest created date downwards
  3. The myDate variable returns today's date - 15/03/2019 - So I know this is finding the correct date
  4. I'm not sure what validation I should do to check if the the sub-folder name matches the "format" required. There may be a file or folder in the directory that do not match the required folder name format
  5. Because I am unable to move past this if statement: If subFolder1.Name = "########_" & myDate & "_" & folderTime Then, I cannot test what is happening after it
  6. I have commented out the code for grabbing the hyperlink as I am not sure if it is correct and I get an error on this line .Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)

Argument not optional

If I am able to work through the issues I am experiencing, then I could continue working on the rest of my task and add to the code.

标签: excel vba
0条回答
登录 后发表回答