[AccessD] Loadfromtext

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




More information about the AccessD mailing list