help with code?

[murlen]

Hi all!

this is my first time playing with code and I need a little help

I'm importing from a text file into a table

the structure of the text file looks like this;

3031,Obecid = QrABAik, type = P, Obec Label = LIIITS, COLOUR = 255, LITCRR = 9, QBNAM = LA, SIPRIP = (1), SIPPER = 2.5, SIDGET = 2002, SIDEND = UPDATE, SCALAQ = 60000, Spatial
3032,Obecid = QgABAik, type= P, Obec Label = LIIITS, COLOUR = 443, LITCRR = 2, OBNAM = Krotz, SIPRIP = (1), SIPPER = 2.5, SIDGET = 2002, SIDEND = 1989, SCALAQ = 60000,
3033,Obecid = QwABAik, type = P, Obec Label = QARZTS, LITCRR = 21, SIDGET = 2001, SIDEND = NONE, COLOUR = 255, SCALAQ = 60000,

this is the code I'm trying to use ;

Function ImportTable()
Dim dbs As Database, rst As Recordset
Dim Directory As String
Dim MyString As String

DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from Table1"
DoCmd.SetWarnings True

Set dbs = CurrentDb
Directory = (Mid(dbs.Name, 1, Len(dbs.Name) - Len(Dir(dbs.Name))))

Open Directory & "\Zoolu1qut.txt" For Input As #1

Set rst = dbs.OpenRecordset("Table1")

Do While Not EOF(1)
Line Input #1, MyString
rst.AddNew
rst!OBECID = Left(MyString, InStr(MyString, "obecid =") - 1)
MyString = Mid(MyString, InStr(MyString, " ") + 1)
rst!OBECLABEL = Left(MyString, InStr(MyString, "obec label") + 1)
MyString = Mid(MyString, InStr(MyString, " ") + 1)
rst.Update
Loop

MsgBox "Done!"

Close #1
rst.Close
Set dbs = Nothing

End Function


Believe me I have no idea what i'm doing , what I'm trying to do is using the do while loop above, add all of the values form the text file to the correct field in the table.

what do I need to add or change in the loop to do this?

thanks!
Murlen

 

[fuzzygeek]

Transfertext

Look up the transfertext Method. With just a few lines you can accomplish the same:

It is designed for importing a text file to a table.

 

[WayneRyan]

murlen,

Your code looks good, but I don't like the way you are
extracting the strings.

Something like this should work for each field.

Dim ptr1 As Integer
Dim ptr2 As Integer

ptr1 = Instr(1, Mystring, "Obecid =")
ptr2 = Instr(ptr1, Mystring, ",")
rst!OBECID = Mid(Mystring, ptr1 + 10, ptr2 - ptr1 + 10)

Other than that things look good!

You will have to add another Line Input inside the loop to
process the second line of each record. Whether you need the
fields or not.

Also, if you can run it with the debugger the first time it
will be a much easier task for you.

Wayne

 

[murlen]

This is exactly what I'm looking for, Thanks Wayne!

but I have another little problem,

If I want to add the the value for 'SIPPER' to the 'SIPPER' field I would add the code,
ptr1 = Instr(1, Mystring, "SIPPER =")
ptr2 = Instr(ptr1, Mystring, ",")
rst!SIPPER = Mid(Mystring, ptr1 + 10, ptr2 - ptr1 + 10)

the problem is SIPPER is not on ever line in the text file so I get a run time error at the above line in the code.

how do I fix this?

P.S. also there are 128 fields that may or may not be on each line in the text file.

Thanks for the Help
Murlen

 

[WayneRyan]

murlen,

When faced with an "inconsistent" set of data like this
there are some work-arounds.

If the data always comes in two line sets you can:

Line Input #1, MyString
Line Input #1, Temp
Mystring = Mystring & Temp

This will let you process each two line set as one record.
It will also handle the cases where the data wraps over
to the next line.

If some of them go to a third or fourth line, then you
will have to add some logic to parse according to the
Record Ids (3031, 3032, etc.)

If you have trouble, post your code with a larger sample
of your file.

Wayne

 

[murlen]

Hi Wayne,

You may have misunderstood me on the last post, sorry

each record is contained on a single line, but as in the example below if "CATKIM" is not listed for the record it creates an error.
If there is no "CATKIM" I need it entered into the field as NULL or even bitter left blank.

here is the latest code I'm using and I have attached a sample of the text file

Thanks for all the help!
Murlen

Function ImportTable()
Dim dbs As Database, rst As Recordset
Dim Directory As String
Dim MyString As String

DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from table1"
DoCmd.SetWarnings True

Set dbs = CurrentDb
Directory = (Mid(dbs.Name, 1, Len(dbs.Name) - Len(Dir(dbs.Name))))

Open Directory & "\zoolu23.txt" For Input As #1

Set rst = dbs.OpenRecordset("table1")

Do While Not EOF(1)
Line Input #1, MyString
rst.AddNew
Dim ptr1 As Integer
Dim ptr2 As Integer
ptr1 = InStr(1, MyString, "Objectid =")
ptr2 = InStr(ptr1, MyString, ",")
rst!OBJECTID = Mid(MyString, ptr1, ptr2 - ptr1)
ptr1 = InStr(1, MyString, "Ftype =")
ptr2 = InStr(ptr1, MyString, ",")
rst!FTYPE = Mid(MyString, ptr1, ptr2 - ptr1)
ptr1 = InStr(1, MyString, "Object Label =")
ptr2 = InStr(ptr1, MyString, ",")
rst!OBJECTLABEL = Mid(MyString, ptr1, ptr2 - ptr1)
ptr1 = InStr(1, MyString, "SORDAT =")
ptr2 = InStr(ptr1, MyString, ",")
rst!SORDAT = Mid(MyString, ptr1, ptr2 - ptr1)
ptr1 = InStr(1, MyString, "CATKIM =")
ptr2 = InStr(ptr1, MyString, ",")
rst!CATKIM = Mid(MyString, ptr1, ptr2 - ptr1)
rst.Update

Loop
MsgBox "Done!"

Close #1
rst.Close
Set dbs = Nothing

End Function

 

[WayneRyan]

murlen,

Hey, that makes it better!

Your New syntax is:

ptr1 = InStr(1, MyString, "Ftype =") 
If Ptr > 0 Then
   ptr2 = InStr(ptr1, MyString, ",") 
   rst!FTYPE = Mid(MyString, ptr1, ptr2 - ptr1) 
Else
   rst!FTYPE = ""
End If

Let me know,
Wayne

 

[murlen]

Hi Wayne

That works great!
Thank you so much for the help

Murlen

 

[murlen]

OK everthing is working great, but if I may ask one additional question
If I wanted to run the code on a different text file and append to the same table, what do I need to do?

thanks
murlen

 

[WayneRyan]

murlen,

The rst.AddNew syntax adds (appends) a record to
your table.

All you have to do is change the name of the input
file on your Open command.

There are ways to have the user browse through the
file system and select a file (using the API).

I'll try and post an example of that.

Also, it never hurts to back up your work and data
often.

Wayne