parse Access tables

[George]

Dear microsoft.public.access.modulesdaovba subscribers,

My task is to parse Access tables named r* (and do not touch other
tables).

Please find example of table here (printscreen) :
http://marchello.ccx-grads.org/example.jpg

I have to parse "blocks" in table and prepare a list _when_ values was
created, changed or deleted.

I say "block" when I mean part of table, for example, after word
"create", it can be empty (no value was created this time) or can
consist of 1 or more values.

7-digit value is management accounting code.

Each name of Access table includes date: r071203_xlsx is the 3th of
December, 2007.

I have to parse about thousand tables. Please, be so kind, suggest me
way of solution.

 

[Stefan Hoffmann]

hi George,

Please find example of table here (printscreen) :
http://marchello.ccx-grads.org/example.jpg

First of all, who has produced theses Excel files? They seem to be very
uselsess to me.
You should really talk to theses guys and ask for better input data.

I have to parse "blocks" in table and prepare a list _when_ values was
created, changed or deleted.

Basically (not tested):

Public Sub Import()

Dim td As DAO.TableDef

For Each td In CurrentDb.TableDefs
If Left(td.Name, 1) = "r" Then
ParseTable td.Name
End If
Next td
Set td = Nothing

End Sub

Public Sub ParseTable(ATableName As String)

Dim rs As DAO.Recordset

Dim List As String

Set rs = CurrentDb.OpenRecordset(ATableName)

If Not rs.Bof And Not rs.Eof Then
Do While Not rs.Eof
If Not IsNull(rs.Fields.Item(1)) Then
List = List & Trim(rs.Fields.Item(1)) & ","
Else
List = List & "eol"
StoreList List
List = ""
End If
rs.MoveNext
Loop
End If

rs.Close
Set rs = Nothing

End Sub

Public Sub StoreList(AList As String)

Dim a() As String
Dim Count As Long
Dim Message As String

a() = Split(AList)

For Count = 0 To UBound(a()) - 1
Message = Message & a(Count) & vbCrLf
Next Count
MsgBox Message

End Sub


mfG
--> stefan <--

 

[George]

Hi Stefan,

Thank you for your reply.

I cannot talk to guys who has produced these Excel files, they have
started years ago and the structure of files still not changed.

Please find current version of working solution below (two modules).

Now I have to merge these two modules into one;
temporary table for importing Excel files must be the one;
I have to add the name of each spreadsheet into table named
tblOutput;
drop all tables except tblOutput after work.
I can't know all names of tables with import errors (description of 7-
digit values is rather to long to import), otherwise I would use sql
with DROP.

Please, be so kind, suggest me the way of solution.
Thanks ahead.

http://marchello.ccx-grads.org/solution.txt

Sub test()

Dim rstCurr As DAO.Recordset
Dim dbsCurr As Database
Dim MyPath As String
Dim MyFile As String
Dim ShortFile As String
MyPath = "C:\Marchello\"
Set dbsCurr = Access.CurrentDb
Set rstCurr = dbsCurr.OpenRecordset("Table1", dbOpenDynaset)
MyFile = Dir(MyPath)
Do While MyFile <> ""
rstCurr.AddNew
'rstCurr.Fields("1").Value = Time$
'rstCurr.Fields("2").Value = Date$
'rstCurr.Fields("3").Value = MyPath
'rstCurr.Fields("4").Value = MyFile
'rstCurr.Update
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, MyFile,
MyPath & MyFile
MyFile = Dir
Loop

End Sub


Sub test()

Dim db As DAO.Database, tdf As DAO.TableDef
Dim strAction As String
Dim rstIn As DAO.Recordset, rstOut As DAO.Recordset

' Point to this database
Set db = CurrentDb
' Open the output recordset
Set rstOut = db.OpenRecordset("tblOutput", _
dbOpenDynaset, dbAppendOnly)
' Loop through all tabledefs
For Each tdf In db.TableDefs
' Look for a table name starting with "r"
'If tdf.Name Like "r*" Then
If Left(tdf.Name, 1) = "r" Then
' Found one - open it
Set rstIn = db.OpenRecordset("SELECT F2 " & _
"FROM [" & tdf.Name & "] " & _
"WHERE Len(F2 & """") > 0")
' Process all the records
Do Until rstIn.EOF
' See if keyword
If (rstIn!F2 = "Create") Or (rstIn!F2 = "Change") _
Or (rstIn!F2 = "Delete") Then
' Just save the action
strAction = rstIn!F2
Else
' Make sure we have a good action
If Len(strAction) > 0 Then
' Write an output record
rstOut.AddNew
rstOut!Field1 = tdf.Name
rstOut!Field2 = rstIn!F2
rstOut!Field3 = strAction
rstOut.Update
End If
End If
' Get the next record
rstIn.MoveNext
Loop
' Close the input
rstIn.Close
End If
' Get the next table
Next tdf
' Clean up
rstOut.Close
Set rstIn = Nothing
Set rstOut = Nothing
Set tdf = Nothing
Set db = Nothing

End Sub