MartyConnelly
martyconnelly at shaw.ca
Mon Sep 25 14:08:31 CDT 2006
Here is some shoddy code I wrote to do this in an MDA Essentially you just insert the high level directory name of all the files in the first call, it then reads through the underlying directories placing all the filenames in a a collection, it then parses through the collection and does a loadfromtext verifying against an array. Dim colMyList As New Collection Sub testfind(strdirpath As String) Dim strDir As String Dim strDirTemp As String Dim strFile As String Dim strFinda As String Dim strFileName As String Dim i As Long Dim ii As Long Dim J As Long Debug.Print colMyList.Count 'clear collection For i = 1 To colMyList.Count - 1 colMyList.Remove (i) Next 'strDirPath = "C:\Documents and Settings\marty\Local Settings\Temp\MDB_Objects\Saveastext2003\" 'strDirPath = "C:\Documents and Settings\marty\Local Settings\Temp\Copy of Northwind\" FindSub strdirpath, "*txt" Dim strtemp As String Debug.Print "count = " & colMyList.Count For i = colMyList.Count - 1 To 1 Step -1 strtemp = fURLWithoutExtension(colMyList(i)) strFinda = fstrReverse(strtemp) 'split out sub directory name like "forms" 'Find the first occurance of the '\' in the FileName string J = InStr(1, strFinda, "\", vbTextCompare) strDirTemp = (Right$(strFinda, Len(strFinda) - J)) strFile = fstrReverse(Left$(strFinda, J - 1)) 'Find the second occurance of the '\' in the FileName string J = InStr(1, strDirTemp, "\", vbTextCompare) strDir = fstrReverse(Left$(strDirTemp, J - 1)) Dim arrVariant As Variant arrVariant = createobjArray For ii = 1 To 6 If arrVariant(ii) = strDir Then Debug.Print arrVariant(ii), strFile, strDir Debug.Print strdirpath Dim strcopy As String strcopy = strdirpath & strDir & "\" & strFile & ".txt" Debug.Print strcopy LoadFromText ii, strFile, strdirpath & strDir & "\" & strFile & ".txt" End If Next ii Next i End Sub Sub FindSub(strStart As String, strFindWhat As String) Dim arrFindDir() As String Dim strFind As String Dim i As Long Debug.Print strStart ChDrive (Left(strStart, 3)) ChDir (strStart) Call DirSub(strFindWhat, strStart) strFind = Dir("*.*", vbDirectory) i = 0 Do Until strFind = "" ReDim Preserve arrFindDir(i) arrFindDir(i) = strFind i = i + 1 strFind = Dir() Loop For i = 0 To UBound(arrFindDir) If Dir(arrFindDir(i), vbNormal) = "" And Left(arrFindDir(i), 1) <> "." Then ' Recursive call Call FindSub(strStart & arrFindDir(i) & "\", strFindWhat) ChDir (strStart) End If Next End Sub Sub DirSub(strFindWhat, strStart) Dim strFindfile As String strFindfile = Dir(strFindWhat, vbNormal) Do While strFindfile <> "" '.lstFiles.AddItem strStart & strFindfile colMyList.Add strStart & strFindfile strFindfile = Dir() Loop End Sub Function createobjArray() As Variant Dim objarr() As String Dim i As Long ReDim objarr(1 To 6) objarr(acForm) = "Forms" objarr(acMacro) = "Macros" objarr(acReport) = "Reports" objarr(acQuery) = "Queries" objarr(acModule) = "Modules" objarr(6) = "DataAccessPages" For i = 1 To UBound(objarr) Debug.Print objarr(i) Next createobjArray = objarr() End Function Function fffURLExtension(strFile As String) As String Dim J As Long Dim strURL 'could use InStrRev but not available in 97 strURL = fstrReverse(strFile) 'Find the url name without extension 'Find the first occurance of the '.' in the FileName string J = InStr(1, strURL, ".", vbTextCompare) If J = 0 Then 'URL name does not contain a '.' character fffURLExtension = strURL Else 'URL name does contain the '.' character fffURLExtension = Left$(strURL, J - 1) End If 'switch reverse back fffURLExtension = fstrReverse(fffURLExtension) End Function Function fffURLWithoutExtension(strFile As String) As String Dim J As Long Dim strURL 'could use InStrRev but not available in 97 strURL = fstrReverse(strFile) 'Find the url name without extension 'Find the first occurance of the '.' in the FileName string J = InStr(1, strURL, ".", vbTextCompare) If J = 0 Then 'URL name does not contain a '.' character fffURLWithoutExtension = strURL Else 'URL name does contain the '.' character fffURLWithoutExtension = Right$(strURL, Len(strURL) - J) End If 'switch reverse back fffURLWithoutExtension = fstrReverse(fffURLWithoutExtension) End Function Function fffstrReverse(strInput As String) As String ' REVERSES A STRING, SPACES & ALL Dim i As Integer For i = Len(strInput) To 1 Step -1 fffstrReverse = fffstrReverse & Mid(strInput, i, 1) Next i End Function Sub listcol() Dim i As Long For i = 1 To colMyList.Count - 1 Debug.Print colMyList.Item(i) Next End Sub Martin Reid wrote: >I want to loop over a folder contain X number of text files. Any ideas. For example > >Application.LoadFromText acForm, "test", "C:\forms\Form_Customer List.txt" > >Instead of a single file I need them all BUT some are prefixed FORM, REPORT,MODULE, QUERY and I need to change the constant accordingly. > >I know I can run one process for each type but would it be possible to do them all in the proper squence in one hit. > >Martin > >Martin WP Reid >Training and Assessment Unit >Riddle Hall >Belfast > >tel: 02890 974477 > > > > >------------------------------------------------------------------------ > >No virus found in this incoming message. >Checked by AVG Free Edition. >Version: 7.1.405 / Virus Database: 268.12.8/455 - Release Date: 22/09/2006 > > -- Marty Connelly Victoria, B.C. Canada