Search for Partial File Name

[Guest]

Hi,
I am writing a macro that will open a number of workbooks in the same
folder, one at a time. The workbooks will have a uniform naming convention,
like Book1_June_Bob.xls, Book2_June_Tim.xls, etc.

In the macro I want to loop through the folder, looking for a workbook where
the LEFT(FileName,5)=â€Book1.†When I find “Book1â€, I want to open it, do some
stuff, close it and then look for “Book2.â€

Is there code that will do that?

 

[Guest]

Sub getbooks()

Const MyPath = "c:\temp"

First = True
Do
If First = True Then
Filename = Dir(MyPath & "\Book1.*")
First = False
Else
Filename = Dir()
End If

If Filename <> "" Then

Workbooks.Open Filename:=MyPath & "\" & Filename

Workbooks(Filename).Close
End If

Loop While Filename <> ""


End Sub

 

[RB Smissaert]

This general purpose function might be of help:


Function ListFilesInFolder(strFolder As String, _
strFileExtension As String, _
Optional strFileFilter As String, _
Optional bIgnoreCase As Boolean = True) As
String()

Dim i As Long
Dim arrFiles As Variant
Dim strDirReturn As String
Dim collFiles As Collection
Dim lFileCount As Long
Dim lFilterLen As Long
Dim strUCaseFilter As String

Set collFiles = New Collection

If Right$(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If

strDirReturn = Dir$(strFolder & strFileExtension, _
vbArchive Or _
vbHidden Or _
vbReadOnly Or _
vbSystem)

If Len(strFileFilter) > 0 Then
lFilterLen = Len(strFileFilter)
If bIgnoreCase Then
strUCaseFilter = UCase(strFileFilter)
Do While Len(strDirReturn)
If UCase(Left$(strDirReturn, lFilterLen)) = strUCaseFilter Then
collFiles.Add strFolder & strDirReturn
End If
strDirReturn = Dir$()
Loop
Else
Do While Len(strDirReturn)
If Left$(strDirReturn, lFilterLen) = strFileFilter Then
collFiles.Add strFolder & strDirReturn
End If
strDirReturn = Dir$()
Loop
End If
Else
Do While Len(strDirReturn)
collFiles.Add strFolder & strDirReturn
strDirReturn = Dir$()
Loop
End If

lFileCount = collFiles.Count

If lFileCount > 0 Then
ReDim arrFiles(1 To lFileCount) As String
For i = 1 To lFileCount
arrFiles(i) = collFiles(i)
Next i
ListFilesInFolder = arrFiles
Else
'so if nil found we return an 0-bound, one element array
'so we can test for this by doing a UBound on the returned array
'---------------------------------------------------------------
ReDim arrFiles(0 To 0) As String
ListFilesInFolder = arrFiles
End If

End Function


Use it like this:

Sub test()

Dim i As Long
Dim arr() As String

arr = ListFilesInFolder("C:\Test\", "*.xls", "Book")

If UBound(arr) > 0 Then
For i = 1 To UBound(arr)
Workbooks.Open Filename:=arr(i)
'do whatever needs doing here
Workbooks(arr(i)).Close
Next i
End If

End Sub


If you want you could return the collection itself, instead of a string
array.


RBS

 

[RB Smissaert]

As Workbooks.Close doesn't work on the full file path, you will need
some code to get the file name, without the full path:


Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean) As String

Dim lFPL As Long 'len of full path
Dim lPLS As Long 'position of last slash
Dim lPD As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

lFPL = Len(strFullPath)
lPLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, lFPL - lPLS)

If bExtensionOff = False Then
FileFromPath = strFile
Else
lPD = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPath = Left$(strFile, lPD - 1)
End If

Exit Function
ERROROUT:

On Error GoTo 0
FileFromPath = ""

End Function

Sub test()

Dim i As Long
Dim arr() As String

arr = ListFilesInFolder("C:\RBSSynergyReporting\SetupFiles\", "*.xls")

If UBound(arr) > 0 Then
For i = 1 To UBound(arr)
Workbooks.Open Filename:=arr(i)
'do whatever needs doing here
Workbooks(FileFromPath(arr(i))).Close
Next i
End If

End Sub


Another option is to only pick up the file name only in the function and add
the folder when needed.


RBS

 

[Guest]

Perfect.
Thanks RBS!
--
Ken Hudson

As Workbooks.Close doesn't work on the full file path, you will need
some code to get the file name, without the full path:


Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean) As String

Dim lFPL As Long 'len of full path
Dim lPLS As Long 'position of last slash
Dim lPD As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

lFPL = Len(strFullPath)
lPLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, lFPL - lPLS)

If bExtensionOff = False Then
FileFromPath = strFile
Else
lPD = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPath = Left$(strFile, lPD - 1)
End If

Exit Function
ERROROUT:

On Error GoTo 0
FileFromPath = ""

End Function

Sub test()

Dim i As Long
Dim arr() As String

arr = ListFilesInFolder("C:\RBSSynergyReporting\SetupFiles\", "*.xls")

If UBound(arr) > 0 Then
For i = 1 To UBound(arr)
Workbooks.Open Filename:=arr(i)
'do whatever needs doing here
Workbooks(FileFromPath(arr(i))).Close
Next i
End If

End Sub


Another option is to only pick up the file name only in the function and add
the folder when needed.


RBS