How to know the Availability of a file in the directory?

A

aaromic2000

New Member
Joined
Jul 28, 2009
Messages
32
I have shared drive mapped to directory "M:\\". I have lot of folders and and subfolders in it.

I want to run a macro which would search the folder name (Column A) in the directory and find the availability of the "Part of the File Name"(Column C)) and return Available/Not Available in Column D.

<TABLE style="WIDTH: 384pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=512><COLGROUP><COL style="WIDTH: 65pt; mso-width-source: userset; mso-width-alt: 3181" width=87><COL style="WIDTH: 104pt; mso-width-source: userset; mso-width-alt: 5046" width=138><COL style="WIDTH: 105pt; mso-width-source: userset; mso-width-alt: 5120" width=140><COL style="WIDTH: 110pt; mso-width-source: userset; mso-width-alt: 5376" width=147><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 65pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=87>Folder Name</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 104pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=138>Region</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 105pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=140>Part of the File Name</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 110pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 width=147>Availability</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20>6986</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>Europe</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>6986 - Europe</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67> </TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20>7142</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>Asia</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>7142 - Asia</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67> </TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20>4387</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>Europe</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>4387 - Europe</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67> </TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20>9841</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>Asia</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>9841 - Asia</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67> </TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20>3681</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>Africa</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67>3681 - Africa</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67> </TD></TR></TBODY></TABLE>

Can any one help me in this??? It's a urgent requirement...
 
Sort by date Sort by votes
I'm extremely sorry Ruddles. The path follows the sub folder as well I missed to inform that...

"M:\\123.45.67.898\Logo\Dates\Aaromic 2000\6986\148\Aaromic 2000 - 6986 - Europe - 148"

This is exactly how the path looks like.
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Okay, try this:-
Code: 
[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys]Option Compare Text[/FONT]
 
[FONT=Fixedsys]Public Sub ConfirmFilesExist_v2()[/FONT]
 
[FONT=Fixedsys]Const StartFolder As String = "M:\"[/FONT]
 
[FONT=Fixedsys]Dim ws As Worksheet[/FONT]
[FONT=Fixedsys]Dim FolderList As New Collection[/FONT]
[FONT=Fixedsys]Dim strFilename As String[/FONT]
[FONT=Fixedsys]Dim strFolderName As String[/FONT]
[FONT=Fixedsys]Dim iLastRow As Long[/FONT]
[FONT=Fixedsys]Dim iRow As Long[/FONT]
[FONT=Fixedsys]Dim iFound As Long[/FONT]
[FONT=Fixedsys]Dim strMatchName As String[/FONT]
 
[FONT=Fixedsys]Set ws = ThisWorkbook.Sheets(1)[/FONT]
[FONT=Fixedsys]iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row[/FONT]
[FONT=Fixedsys]ws.Range("D2:D" & CStr(iLastRow)).ClearContents[/FONT]
[FONT=Fixedsys]FolderList.Add StartFolder[/FONT]
 
[FONT=Fixedsys]While FolderList.Count > 0[/FONT]
[FONT=Fixedsys]strFolderName = FolderList.Item(1)[/FONT]
[FONT=Fixedsys]FolderList.Remove 1[/FONT]
[FONT=Fixedsys]strFilename = Dir(strFolderName, vbDirectory)[/FONT]
[FONT=Fixedsys]While strFilename <> ""[/FONT]
[FONT=Fixedsys]  If strFilename <> "." And strFilename <> ".." Then[/FONT]
[FONT=Fixedsys]    If GetAttr(strFolderName & strFilename) = vbDirectory Then[/FONT]
[FONT=Fixedsys]      FolderList.Add strFolderName & strFilename & "\"[/FONT]
[FONT=Fixedsys]    Else[/FONT]
[FONT=Fixedsys]       For iRow = 2 To iLastRow[/FONT]
[FONT=Fixedsys]         If IsEmpty(ws.Cells(iRow, 4)) Then[/FONT]
[FONT=Fixedsys]           strMatchName = ws.Cells(iRow, 3)[/FONT]
[FONT=Fixedsys]           If InStr(strFilename, strMatchName) > 0 Then[/FONT]
[FONT=Fixedsys]             ws.Cells(iRow, 4) = "yes"[/FONT]
[FONT=Fixedsys]             [COLOR=red]ws.Cells(iRow, 5) = strFolderName & strFilename[/COLOR][/FONT]
[FONT=Fixedsys]           End If[/FONT]
[FONT=Fixedsys]         End If[/FONT]
[FONT=Fixedsys]       Next iRow[/FONT]
 
[FONT=Fixedsys]    End If[/FONT]
[FONT=Fixedsys]  End If[/FONT]
[FONT=Fixedsys]  strFilename = Dir[/FONT]
[FONT=Fixedsys]Wend[/FONT]
[FONT=Fixedsys]Wend[/FONT]
 
[FONT=Fixedsys]iFound = 0[/FONT]
[FONT=Fixedsys]For iRow = 2 To iLastRow[/FONT]
[FONT=Fixedsys]If IsEmpty(ws.Cells(iRow, 4)) Then[/FONT]
[FONT=Fixedsys]  ws.Cells(iRow, 4) = "no"[/FONT]
[FONT=Fixedsys]Else[/FONT]
[FONT=Fixedsys]  iFound = iFound + 1[/FONT]
[FONT=Fixedsys]End If[/FONT]
[FONT=Fixedsys]Next iRow[/FONT]
 
[FONT=Fixedsys][COLOR=red]MsgBox vbCrLf _[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=red]   & Space(5) & CStr(iLastRow - 1) & " file name" & IIf(iLastRow = 2, "", "s") _[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=red]   & " checked" & Space(10) & vbCrLf & vbCrLf _[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=red]   & Space(5) & CStr(iFound) & " file" & IIf(iFound = 1, "", "s") _[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=red]   & " found" & Space(10), _[/COLOR][/FONT]
[FONT=Fixedsys][COLOR=red]   vbOKOnly + vbInformation, "Aaromic2000 File Checker v2"[/COLOR][/FONT]
 
[FONT=Fixedsys]End Sub[/FONT]

Remove either or both of the bits in red if they're intrusive.
 
Last edited:
Upvote 0
Oops, no, I've been thinking about this: you only need to find the partial name in column C if the path contains the directory stated in column A. That version will find the partial name even if it isn't in that path.

Try this revised version:-
Code: 
[FONT=Fixedsys]Option Explicit
Option Compare Text[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub ConfirmFilesExist_v2()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Const StartFolder As String = "M:\"
  
  Dim ws As Worksheet
  Dim FolderList As New Collection
  Dim strFileName As String
  Dim strFolderName As String
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iFound As Long
  Dim strMatchFileName As String
  Dim strMatchFolderName As String
  Dim dtStart As Date
  
  Set ws = ThisWorkbook.Sheets(1)
  iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  ws.Range("D2:E" & CStr(iLastRow)).ClearContents[/FONT]
[FONT=Fixedsys]  dtStart = Now()
  
  FolderList.Add StartFolder
  While FolderList.Count > 0
    strFolderName = FolderList.Item(1)
    FolderList.Remove 1
    strFileName = Dir(strFolderName, vbDirectory)
    While strFileName <> ""
      If strFileName <> "." And strFileName <> ".." Then
        If GetAttr(strFolderName & strFileName) = vbDirectory Then
          FolderList.Add strFolderName & strFileName & "\"
        Else
          For iRow = 2 To iLastRow
            strMatchFolderName = "\" & ws.Cells(iRow, 1) & "\"
            If IsEmpty(ws.Cells(iRow, 4)) Then
              strMatchFileName = ws.Cells(iRow, 3)
              If InStr(strFileName, strMatchFileName) > 0 Then
                If InStr(strFolderName, strMatchFolderName) > 0 Then
                  ws.Cells(iRow, 5) = strFolderName & strFileName
                  ws.Cells(iRow, 4) = "yes"
                End If
              End If
            End If
          Next iRow
        End If
      End If
      strFileName = Dir
    Wend
  Wend[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  iFound = 0
  For iRow = 2 To iLastRow
    If IsEmpty(ws.Cells(iRow, 4)) Then
      ws.Cells(iRow, 4) = "no"
    Else
      iFound = iFound + 1
    End If
  Next iRow[/FONT]
 
[FONT=Fixedsys]  MsgBox vbCrLf _
       & Space(5) & CStr(iLastRow - 1) & " file name" & IIf(iLastRow = 2, "", "s") _
       & " checked" & Space(10) & vbCrLf & vbCrLf _
       & Space(5) & CStr(iFound) & " file" & IIf(iFound = 1, "", "s") _
       & " found" & Space(10) & vbCrLf & vbCrLf _
       & Space(5) & "Run time: " & Format(Now() - dtStart, "hh:nn:ss") & Space(10), _
       vbOKOnly + vbInformation, "Aaromic2000 File Checker v2"
         
End Sub
[/FONT]
 
Upvote 0
Hi Ruddles,

Thank u very much for your help... The code works fine... :)

I have one last question... I've planned to use this code in a citrix connected share drive... Will it be a problem in doing so...
 
Upvote 0
To be honest I have no idea, and I don't have access to Citrix to test it. I think you would have to try it and see how it behaves.

I'll be happy to look at it again if it doesn't work but I'm not sure how I would change it.
 
Upvote 0
Hello Ruddles,

Sorry to bother you again... Please advise me if there is any reference library that needs to be added specifically to run this code. The code is not working in Excel 2007... I set break point in the code and tracked the error. I found that code does not enter the While loop. It directly goes to the For loop in the end...

Any guess...? The code you gave me is enclosed below..

Public Sub BtnQC_Click()

Const StartFolder As String = "Z:\\"

Dim ws As Worksheet
Dim FolderList As New Collection
Dim strFileName As String
Dim strFolderName As String
Dim iLastRow As Long
Dim iRow As Long
Dim iFound As Long
Dim strMatchFileName As String
Dim strMatchFolderName As String
Dim dtStart As Date

Set ws = ThisWorkbook.Sheets(1)
iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws.Range("D2:E" & CStr(iLastRow)).ClearContents
dtStart = Now()

FolderList.Add StartFolder
While FolderList.Count > 0

strFolderName = FolderList.Item(1)
FolderList.Remove (1)
strFileName = Dir(strFolderName, vbDirectory)
While strFileName <> ""
If strFileName <> "." And strFileName <> ".." Then
If GetAttr(strFolderName & strFileName) = vbDirectory Then
FolderList.Add strFolderName & strFileName & "\"
Else
For iRow = 2 To iLastRow
strMatchFolderName = "\" & ws.Cells(iRow, 1) & "\"
If IsEmpty(ws.Cells(iRow, 4)) Then
strMatchFileName = ws.Cells(iRow, 3)
If InStr(strFileName, strMatchFileName) > 0 Then
If InStr(strFolderName, strMatchFolderName) > 0 Then
ws.Cells(iRow, 5) = strFolderName & strFileName
ws.Cells(iRow, 4) = "Yes"
End If
End If
End If
Next iRow
End If
End If
strFileName = Dir
Wend
Wend

iFound = 0
For iRow = 2 To iLastRow
If IsEmpty(ws.Cells(iRow, 4)) Then
ws.Cells(iRow, 4) = "No"
Else
iFound = iFound + 1
End If
Next iRow

MsgBox vbCrLf _
& Space(5) & CStr(iLastRow - 1) & " file name" & IIf(iLastRow = 2, "", "s") _
& " checked" & Space(10) & vbCrLf & vbCrLf _
& Space(5) & CStr(iFound) & " file" & IIf(iFound = 1, "", "s") _
& " found" & Space(10) & vbCrLf & vbCrLf _
& Space(5) & "Run time: " & Format(Now() - dtStart, "hh:mm:ss") & Space(10), _
vbOKOnly + vbInformation, "File Checker"

End Sub
 
Upvote 0
No, it doesn't rely on anything else. I'm not keen on that double backslash but that shouldn't stop it working.

In place of this code:-
Code: 
  FolderList.Add StartFolder
use this code:-
Code: 
  If Right(StartFolder, 1) = "\" Then
    FolderList.Add Left(StartFolder, Len(StartFolder) - 1)
  Else
    FolderList.Add StartFolder
  End If

Then place a breakpoint at the FolderList.Add command and check what the value of FolderList.Count is. If it's zero, something odd is happening.
 
Upvote 0
The code you posted works perfectly in my workbook (Excel 2007).

Okay, let's strip it down to its barest minimum:-
Code: 
Option Explicit
 
Public Sub TestFrame()
 
  Dim FolderList As New Collection
  
  FolderList.Add "C:\"
  
  MsgBox "FolderList.Count=" & FolderList.Count
         
End Sub
You've got to agree that should add "C:\" to the collection, yes?

Run it under 2003 and 2007. What does it report?

(Note: when posting code, please place it between CODE tags - the # icon in the advanced editor toolbar.)
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
537
smozgur
smozgur
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
G
  • Question Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
1K
gvsumich
G
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
902
epactheactor
E
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C

Forum statistics

Threads
1,223,237
Messages
6,170,928
Members
452,366
Latest member
TePunaBloke

Share this page

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
Back
Top