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