Search for file in windows folder including subfolders matching cell value

Bennieboef

New Member
Joined
Dec 2, 2019
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Hello,

I'm looking to expand my code to search for a file in a windows folder including subfolders.
Here's my code (this code only searches in the root "S:\":

Option Explicit

Sub Find_DLD()
Dim AckTime As Integer, InfoBox As Object
Dim iRow As Integer ' ROW COUNTER.
Dim sSourcePath As String
Dim sDestinationPath As String
Dim sFileType As String
Dim sFileType1 As String

Dim bContinue As Boolean

bContinue = True
iRow = 2

' THE SOURCE AND DESTINATION FOLDER WITH PATH.
sSourcePath = "S:\"

sFileType = ".dld" ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
sFileType1 = "prd."


' LOOP THROUGH COLUMN "B" TO PICK THE FILES.
While bContinue

If Len(Range("E" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 1
Select Case InfoBox.Popup("Klaar.", _
AckTime, "Hieperdepiep", 0)
Case 1, -1
Exit Sub
End Select
Else
' CHECK IF FILES EXISTS.

If Len(Dir(sSourcePath & sFileType1 & Range("E" & CStr(iRow)).Value & sFileType)) = 0 Then
Range("F" & CStr(iRow)).Value = "Geen kantprogramma"
Range("F" & CStr(iRow)).Font.Bold = True
Else
Range("F" & CStr(iRow)).Value = "Kantprogramma bestaat!"
Range("F" & CStr(iRow)).Font.Bold = False


End If
End If
iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
End Sub


Thanks for your help
 

Bennieboef

New Member
Joined
Dec 2, 2019
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Hello John,

It seems to find the file now and that's great.
The only part that does not work yet is the message in column "F" if the file exist or not.

Code:
foundFile = Find_File(allFiles, sFileStart & .Cells(iRow, "E").Value & sFileType)

                If foundFile <> "" Then

                    .Cells(iRow, "F").Value = "Geen kantprogramma" ' file not found

                    .Cells(iRow, "F").Font.Bold = True

                Else

                    .Cells(iRow, "F").Value = "Kantprogramma bestaat!" ' file found

                    .Cells(iRow, "F").Font.Bold = False

Thank you for taking the time and effort in doing this for me.

PS. I used the code you send me in the beginning because i thought that the only problem was column "F".
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,622
I inadvertently reversed the found/not found logic from your original code. Try this, which also puts the found file in column G.

VBA Code:
                foundFile = Find_File(allFiles, sFileStart & .Cells(iRow, "E").Value & sFileType)
                If foundFile = "" Then
                    .Cells(iRow, "F").Value = "Geen kantprogramma"      'file not found
                    .Cells(iRow, "F").Font.Bold = True
                Else
                    .Cells(iRow, "F").Value = "Kantprogramma bestaat!"  'file found
                    .Cells(iRow, "F").Font.Bold = False
                    .Cells(iRow, "G").Value = foundFile
                End If
Interesting that the compound If statement in the Find_File function doesn't work for you. You could try this version, which has brackets around each part:

Code:
            If (p > 0) And (p + Len(fileName) = Len(filesArray(i))) Then Find_File = filesArray(i)
 

Bennieboef

New Member
Joined
Dec 2, 2019
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
I inadvertently reversed the found/not found logic from your original code. Try this, which also puts the found file in column G.

VBA Code:
                foundFile = Find_File(allFiles, sFileStart & .Cells(iRow, "E").Value & sFileType)
                If foundFile = "" Then
                    .Cells(iRow, "F").Value = "Geen kantprogramma"      'file not found
                    .Cells(iRow, "F").Font.Bold = True
                Else
                    .Cells(iRow, "F").Value = "Kantprogramma bestaat!"  'file found
                    .Cells(iRow, "F").Font.Bold = False
                    .Cells(iRow, "G").Value = foundFile
                End If
Interesting that the compound If statement in the Find_File function doesn't work for you. You could try this version, which has brackets around each part:

Code:
            If (p > 0) And (p + Len(fileName) = Len(filesArray(i))) Then Find_File = filesArray(i)
Hi John,

It works!
Thank you very much for your help.
My folder with files was becoming much too big but now i can create subfolders and still search for files.
My plan is to follow a course VBA programming so i won't have to bother people on forums anymore and maybe i can help them just like you.
(and also a course english in writing ;))

Thank you very much.

Greetings,
Benjamin
 

Bennieboef

New Member
Joined
Dec 2, 2019
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Hi John,

It works!
Thank you very much for your help.
My folder with files was becoming much too big but now i can create subfolders and still search for files.
My plan is to follow a course VBA programming so i won't have to bother people on forums anymore and maybe i can help them just like you.
(and also a course english in writing ;))

Thank you very much.

Greetings,
Benjamin
Here's a screenshot
 

Attachments

  • Perfect.JPG
    Perfect.JPG
    50.3 KB · Views: 2

Watch MrExcel Video

Forum statistics

Threads
1,123,231
Messages
5,600,427
Members
414,384
Latest member
joehalks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top