Page 2 of 2 FirstFirst 1 2
Results 21 to 24 of 24

Thread: Read Text file into Table - Access 1707

  1. #21
    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?

  2. #22
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,297
    Location
    I will send it tomorrow.

  3. #23
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,297
    Location
    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.

    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.

  4. #24
    Got the file - THANK YOU - you rock!!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •