Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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? -- Ken Hudson |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 "Ken Hudson" wrote: 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? -- Ken Hudson |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 "Ken Hudson" wrote in message ... 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? -- Ken Hudson |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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\SetupFil es\", "*.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 "RB Smissaert" wrote in message ... 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 "Ken Hudson" wrote in message ... 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? -- Ken Hudson |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Perfect.
Thanks RBS! -- Ken Hudson "RB Smissaert" wrote: 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\SetupFil es\", "*.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 "RB Smissaert" wrote in message ... 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 "Ken Hudson" wrote in message ... 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? -- Ken Hudson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Partial string search w/o VBA? | Excel Discussion (Misc queries) | |||
partial search | Excel Programming | |||
how to use partial (word) search | Excel Programming | |||
Partial search and replace? | Excel Discussion (Misc queries) | |||
Partial Search using Macro | Excel Programming |