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?
Printable View
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.
The code collects together anything that does not meet the test criteria and adds it to the field MISC1.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
Got the file - THANK YOU - you rock!!