Read Text file into Table - Access 1707

Hi All - I have the pleasure of trying to parse extracted text into a table. I seem to have plateaued with Excel/Access/RegEx/Google and would appreciate a kick-start!

I'm having the hardest time finding snippets to code I understand and will work with my Windows Environment (Windows 10 - Access 1707 Office 365)

The text below is a sample of the thousands of line's I need to process. My current thought is to

open text file
var = readline.text
int misc = 1 /*keep tally of records that fail CASE()
Case Left(text,3) =

"(G-"

misc = 1

new record

FieldA = var

"P." = FieldB = var

"PA"....etc

else

copy var to Field(misc)

misc++

End Case

PS. WOW so many variants of VBA, ADO DAO how do you know what to do?!?!

=======data below=====
(G-1723)Aberdeen - Brown READY BOX CO (HQ) ??
Storage Division
Also Called RBC
704 Lawrence Rd (99999-9999)
P.O. Box 6 (99999-9999)
PHONE......................999 999-9999
TOLL FREE: 800 999-9999
FAX: 999 999-9999
Paul Smith, President
Cliff Smith, VP Marketing
C T House, Plant Manager
EMP: 50 EST: 1992
SQ FT: 11,000
SALES (est): 17.2MM Publicly Held
SALES (corp-wide): 1.2B
WEB: website
SIC: 2657 2675 2679 Folding paperboard boxes;
die cutting
HQ: Intl Box Co
500 5th Ave
New York, NY 10001
212 800-4800
ANYTOWN
Any County
(G-11)Aberdeen - Moore INTERNTNAL TRAY PADS
PACKG INC
3299 Nc Highway 5 (28315-8619)
P.O. Box 307 (28315-0307)
PHONE...................................910 944-1800
Fax: 910 944-7356
XJ Knorr, President
XKirkpatrick, Corp Secy
XHogan, Shareholder
EMP: 35
SQ FT: 100,000
SALES (est): 4.2MM Privately Held
WEB: website
SIC: 2671 5199 Packaging paper & plastics
film, coated & laminated; packaging
materials
HQ: Pactiv Llc
1900 W Field Ct
Lake Forest IL 60045
847 482-2000
(G-12)Aberdeen - Moore JONATHON M FRANCIS
Also Called: Francis Fabricators & Erectors
240 Crestline Ln (28315-7797)
P.O. Box 142 (28315-0142)
PHONE...................................910 585-8112
XFrancis, Owner
XFrancis, Officer
EMP: 7
SALES (est): 280K Privately Held
SIC: 1541 3441 Steel building construction;
building components, structural steel
(G-13)Aberdeen - Moore KOLCRAFT ENTERPRISES INC
10832 Nc Highway 211 E (28315-4722)
PHONE...................................910 944-9345
Fax: 910 944-3490
XCunliffe, General Mgr
XBird, Vice Pres
XDanko, Vice Pres
XCharles, Sales Mgr
XSchuchard, Manager
EMP: 169
SALES (corp-wide): 29.8MM Privately
Held
SIC: 2512 2511 Juvenile furniture: upholstered
on wood frames; wood household
furniture
PA: Kolcraft Enterprises, Inc.
1100 W Monroe St Ste 1
Chicago IL 60607
312 361-6315

If you explore the Post above yours you will find code for importing text.
http://www.vbaexpress.com/forum/show...ds-into-Access
There is also this one as well
http://www.vbaexpress.com/forum/showthread.php?59949-File-Dialog-Browse-Save-Append

I am not sure from your snippet of code what it is you have to achieve.

Thank you - this helps a lot with importing text for my version - guess a little more foot work for testing values

Best!

Let us know if you need help with that part.

I appreciate that! Turns out that there are so many issues with the original text file that I had clean-up the text anyways and now in Excel .

Now I am on the 'CASE' situation and am having a hard time - any thoughts are appreciated...



Sub MoveFields()
Dim db As DAO.Database, recIn As DAO.Recordset, recOut As DAO.Recordset

Dim f As Field

Set db = CurrentDb()
Set recIn = db.OpenRecordset("InputTable", dbOpenDynaset, dbReadOnly)
Set recOut = db.OpenRecordset("OutputTable", dbOpenDynaset, dbEditAdd)


With recIn
.MoveFirst
Do

recOut.AddRecord

for f in .Fields ' ERROR!!
Select Case Left(f.??, 3) 'How do I toggle through fields as an array
Case "(G-"
recOut.Fields("?") = .Fields("?").Value
Case "P.O"
Case Else

'do the misc() loop to catch fields that do not meet CASE)

recOut.Update
Next f ' next field
.MoveNext ' next record
Loop Until .EOF
End With
recIn.Close
recOut.Close
db.Close
End Sub

Ok, your recordsets look OK as does your loop.
However the the syntax for looking at fields and also adding records to the recout table are not correct.
The syntax for the test also looks suspect.
Can you provide me with a simple example of what you have and what you want it to achieve, or post some dummy data for me to work with?

WOW - that's be great!

For some reason can't upload files to forum nor link but here's a path to it: atlasmotorworks DOT com/tmp/recIn.zip


iNumMisc = 1 'in recordset loop = counter to track misc() fields that were not captured in Case

SELECT CASE Left(f.Value,3)

SAL write to recOut.SALES
PHO write to recOut.PHONE
EMP write to recOut.EMPLOYEES
SIC write to recOut.SIC
SQ write to recOut.SQ FT
FAX write to recOut.FAX
WEB write to recOut.WEB

Case Else

recOut.Misc & Str(iNumMisc) = .f.Value ' correct concat?
iNumMisc++

.

OK, I have the file, I will import it into Access and work on it there. I will post something tomorrow.
I take it that you want normal fields to transferred as is to the new table?

Row 12812 is totally messed up, it appears that it contains a lot more than one record.
Shall I ignore it for now?
And 19906

THANK YOU - no rush!

re:
normal fields - yes, I should be able to clean-up - I really just need syntax and should be able to fake it from there....

TY also for head-up on 12812 - I did not see an error in the XLS but can limit to say 50 records - just sent to whole file to give an idea of the distribution or fields & breadth of data (have 3 more similar tables)

Again, thank you SO much - I really appreciate it!

Take a look at 19906 as well.
I will remove those 2 lines and re-import, as it messed up the table completeley.
Sorry the other line is 19905, not 6

You also do not have any headings in the Sheet, do you have a sheet with the correct headings, or an Access table?

Quote:

---

Originally Posted by OBP

You also do not have any headings in the Sheet, do you have a sheet with the correct headings, or an Access table?

---

The field names can be anything - but pls don't worry - I should be able to figure it out - just struggling w/syntax.

However this is how I see the table right now but very flexible & open to suggestions

County/City ' these 3 will be from first column using REGEX to separate county/city from Name -
Company ' the following fields that I'm likely going to concat to make name
DBA
Address ' this and following fields will be populated by CASE
SALES
PHONE
EMPLOYEES
SIC
NEW RECORD
SQ FT
FAX
WEB
DBA
P.O
PA:
HQ:
MISC1 'these are for
MISC2
MISC3
MISC4
MISC5
MISC6
MISC7
MISC8
MISC9
MISC10

You have a variety of Zip codes within field 2, do you want to use them?
There are 1719 records with the Phone number in the wrong column, which will probably need a second run.
I will see how it goes.

There are a lot of messed up records where the data is concatenated records, another bad one is 16472 in my table "(G-16576)North Richland Hills - Tarrant HAX TECHNOLOGIES LLC" in the first field.

Hello.

Yes, I'm aware of the many discrepancies but worried I am taking too much of your generosity!

I still have a lot of pre-processing to do on the raw text. A lot of replace & regex is still needed for sure. With the amount of data i was 'assuming' this would be a lot of trial-error before I get it close. This is part of why I was hoping the CASE statement could put the data in the corresponding field.

Rather than take any of your time than needed could you kindly look at my pseudocode and advice on proper syntax - that would be awesome!!

I have already got most of the data that you need placed in the appropriate fields.
I am going out tonight so I will post what I have for you to test and look at the code shortly.
I am currently trying to get the first field data to parse.

That is great! I can't tell you how much I appreciate it!

But honestly anything you have is going to be lightyears better than what I could have done with much more work!

Not sure this is a help - but for the first field I use this code (in Excel):
Function SplitCaps(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "([a-z])([a-z])([ ])([A-Z]([A-Z]|[ ]))"
SplitCaps = .Replace(strIn, "$1$2~$4$5")
End With
End Function

It only does the first record for now.
But you can see how the code works.
Can't upload it as it is too large, if you private mail me you email address I will send it to you later but here is the actual code.

Code:

---

Private Sub Command0_Click()
Dim data As String, count As Integer, count2 As Integer, Start As Integer, finish As Integer, rstable As Object
Dim recount As Integer, innerstring As Integer, start2 As Integer, records As Integer, rs As Object, x As Integer
Dim first As Integer, fieldcount As Integer, i As Integer
On Error GoTo errorcatch
Set rstable = CurrentDb.OpenRecordset("Data")
Set rs = CurrentDb.OpenRecordset("Sheet2")
fieldcount = rs.Fields.count
rs.MoveLast
recount = rs.RecordCount
rs.MoveFirst
For records = 1 To 1 'recount
    x = x + 1
    rstable.AddNew
    With rs
        For i = 1 To fieldcount - 1
            If Not IsNull(.Fields(i)) Then
            data = .Fields(i)
            If i = 1 Then
                start2 = InStr(1, data, ")")
                Start = InStr(1, data, "- ")
                finish = InStr(Start, data, " ")
                rstable.Company = Right(data, Len(data) - finish)
                rstable.[County/City] = Mid(data, start2 + 1, finish - 1)
            End If
           
            If i = 2 Then rstable.Address = data
            If Left(data, 5) <> "PHONE" Then rstable.Address = data
            If Left(data, 5) = "PHONE" Then rstable.PHONE = Right(data, 11)
            If Left(data, 3) = "FAX" Then rstable.FAX = Right(data, 11)
            If Left(data, 5) = "EMP: " Then rstable.EMPLOYEES = Right(data, Len(data) - 5)
            If Left(data, 5) = "SIC: " Then rstable.SIC = Right(data, Len(data) - 5)
            If Left(data, 4) = "HQ: " Then rstable.[HQ:] = Right(data, Len(data) - 4)
            If Left(data, 5) = "WEB: " Then rstable.WEB = Right(data, Len(data) - 5)
            If Left(data, 6) = "SALES " Then rstable.SALES = Right(data, Len(data) - 6)
            If Left(data, 7) = "SQ FT: " Then rstable.[SQ FT] = Right(data, Len(data) - 7)
            innerstring = InStr(1, data, "P.O. BOX")
            If innerstring <> 0 Then rstable.PO = Right(data, Len(data) - (innerstring + 8))
            End If
        Next i
    End With
    rstable.Update
    rstable.Bookmark = rstable.LastModified
    rs.MoveNext
Next records
rs.Close
Set rs = Nothing
rstable.Close
Set rstable = Nothing
MsgBox "added " & x & " records"
Exit Sub
errorcatch:
MsgBox records & " " & i & " " & x & " " & Err.Description & " " & fname

End Sub

---

My what #beautiful code!!

It looks like you are both moving through the record AND parsing the extraneous data!?!?!

Man - so many nuggets to glean here!!!

Hadn't tried the code yet but looking at it it looks like it should do each record w/rs.MoveNext no? Or do I have to rstable.MoveNext as well?

I will send it tomorrow.

I have sent you the latest version of the database the imported table is Sheet2 and the destination table for the parsed data is called Data.
The vba code is on a button (Transfer data to table" on Form1 which opens automatically.
For anyone else interested in the code here it is.

Code:

---

Dim data As String, count As Integer, count2 As Integer, Start As Integer, finish As Integer, rstable As Object
Dim recount As Integer, innerstring As Integer, start2 As Integer, records As Integer, rs As Object, x As Integer
Dim first As Integer, fieldcount As Integer, i As Integer
On Error GoTo errorcatch
Start = 0
start2 = 0
finish = 0
Set rstable = CurrentDb.OpenRecordset("Data")
Set rs = CurrentDb.OpenRecordset("Sheet2")
fieldcount = rs.Fields.count
rs.MoveLast
recount = rs.RecordCount
rs.MoveFirst
For records = 1 To recount
    x = x + 1
    rstable.AddNew
    With rs
        For i = 1 To fieldcount - 1
            If Not IsNull(.Fields(i)) Then
            data = .Fields(i)
            If i = 1 Then
                start2 = InStr(1, data, ")")
                Start = InStr(1, data, "- ")
                finish = InStr(Start + 2, data, " ")
              ' MsgBox "start = " & Start & " start2 = " & start2 & " finish = " & finish
                rstable.Company = Right(data, Len(data) - finish)
                rstable.[County/City] = Mid(data, start2 + 1, finish - start2)
            End If
           
            If i = 2 Then rstable.Address = data
            If i = 3 And Left(data, 5) <> "PHONE" Then
                rstable.Company = rstable.Company & " --- " & rstable.Address
                rstable.Address = data
            End If
            If Left(data, 5) = "PHONE" Then rstable.PHONE = Right(data, 11)
            If Left(data, 3) = "FAX" Then rstable.FAX = Right(data, 11)
            If Left(data, 5) = "EMP: " Then rstable.EMPLOYEES = Right(data, Len(data) - 5)
            If Left(data, 5) = "SIC: " Then rstable.SIC = Right(data, Len(data) - 5)
            If Left(data, 4) = "HQ: " Then rstable.[HQ:] = Right(data, Len(data) - 4)
            If Left(data, 5) = "WEB: " Then rstable.WEB = Right(data, Len(data) - 5)
            If Left(data, 6) = "SALES " Or Left(data, 6) = "SALES:" Then rstable.SALES = Right(data, Len(data) - 6)
            If Left(data, 7) = "SQ FT: " Then rstable.[SQ FT] = Right(data, Len(data) - 7)
            innerstring = InStr(1, data, "P.O. BOX")
            If innerstring <> 0 Then rstable.PO = Right(data, Len(data) - (innerstring + 8))
            End If
            If i > 5 _
            And data <> "" _
            And Left(data, 5) <> "PHONE" _
            And Left(data, 3) <> "FAX" _
            And Left(data, 5) <> "EMP: " _
            And Left(data, 5) <> "SIC: " _
            And Left(data, 4) <> "HQ: " _
            And Left(data, 5) <> "WEB: " _
            And Left(data, 6) <> "SALES " _
            And Left(data, 6) <> "SALES:" _
            And Left(data, 7) <> "SQ FT: " Then
                rstable.misc1 = rstable.misc1 & " - " & data
            End If
            data = ""
        Next i
    End With
    rstable.Update
    rstable.Bookmark = rstable.LastModified
    Start = 0
    start2 = 0
    finish = 0
    rs.MoveNext
Next records
rs.Close
Set rs = Nothing
rstable.Close
Set rstable = Nothing
Me.Message = "added " & x & " records"
Exit Sub
errorcatch:
MsgBox records & " " & i & " " & x & " " & Err.Description & " " & fname

---

The code collects together anything that does not meet the test criteria and adds it to the field MISC1.

Got the file - THANK YOU - you rock!!