Import fixed width text file using VBA into MS Access

0
votes

First and foremost, I am a novice at VBA. I am trying to use VBA, to import text files into MS Access tables. One of my challenges is the data is not always on the same lines of the text, but, the data is always the same columns and number of spaces. I'm tested several options, but, none efficient in any way. I have an old database, that does do the task, but, the code is hidden/locked, and the database is out of date, hence why I'm trying to recreate. Thank you in advance for any guidance.

Here's a sample of my text file report: The data fields are (NAME, EMP, LVL, CODE1, CODE2, OFCC, COURSE CODE, NARRATIVE, DUR INTVL, STATUS, STATUS DATE, DUE DATE, EVTID)

                                                                          DATA 
                                                                        TRAINING                

INPUT IMAGE      
TRAINING                                                                                                           SECTION-PAGE:   1

ORG ID:  0001                             BRANCH:  OFFC1 

                                       SERIES/STEP    COURSE                              DUR            STATUS     DUE 
    NAME            EMP    LVL   CODE1   CODE2   OFCC  CODE       NARRATIVE              INTVL STATUS     DATE      DATE     EVT-ID 

JOINES JAMES        57801  001   000A1   000A1   NIME 000001 COURSETITLE                  001A *QUAL             01 JAN 17  
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17

                                                             PAGE     1

                                                                          DATA 
                                                                        TRAINING  

INPUT IMAGE      
TRAINING                                                                                                           SECTION-PAGE:   2

ORG ID:  0001                             BRANCH:  OFFC2 

                                       SERIES/STEP    COURSE                              DUR            STATUS     DUE 
    NAME            EMP    LVL   CODE1   CODE2   OFCC  CODE       NARRATIVE              INTVL STATUS     DATE      DATE     EVT-ID 

GAINES JAMIE        45602  001   000A1   000A1   AIME 000001 COURSETITLE                  001A *QUAL             01 JAN 17  
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17

                                                             PAGE     2

                                                                          DATA 
                                                                        TRAINING

INPUT IMAGE      
TRAINING                                                                                                           SECTION-PAGE:   2

ORG ID:  0001                             BRANCH:  OFFC2 

                                       SERIES/STEP    COURSE                              DUR            STATUS     DUE 
    NAME            EMP    LVL   CODE1   CODE2   OFCC  CODE       NARRATIVE              INTVL STATUS     DATE      DATE     EVT-ID 

JONESY CHADE        12303  001   000A1   000A1   AIME 000001 COURSETITLE                  001A *QUAL             01 JAN 17  
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17   
                                                      000001 COURSETITLE                  001A *QUAL             01 JAN 17

                                                             PAGE     3

Here is one version of VBA that I tried to use to import a text file to a table in MS Access. I've had a couple of errors that I couldn't figure out, so I'm not sure if I'm going in the right direction.

Private Sub Command0_Click()
On Error GoTo Err_Command0_Click

'Requires reference to Microsoft Office 10.0 Object Library or later.

Dim varFile As Variant, db As Database, rec As Recordset
Dim sNAME As String, sEMP As String, sGRD As String
Dim sWC As String, sCOURSECODE As String, sNARRATIVE As String
Dim sSTATUS As String, dSTATUSDATE As Date, dDUEDATE As Date, sEVTID As String

'Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog
  .AllowMultiSelect = False
  .Title = "Please select one file to import"  'Set the title of the dialog box.
  .Filters.Clear
  .Filters.Add "Text files", "*.txt", 1

  'Show the dialog box. If the .Show method returns True, the user picked at least one file. If the .Show method returns False, the user clicked Cancel.
  If .Show = True Then
      For Each varFile In .SelectedItems
         Set db = CurrentDb
         DoCmd.SetWarnings False
         DoCmd.RunSQL "Delete * from [TMA]"
         DoCmd.SetWarnings True
         Set rec = db.OpenRecordset("TMA")


Print #2, TextLine
        With Text
         'NAME
            If Trim(Mid(TextLine, 1, 19)) = "" Then
                .Cells(CurrentRow, 1) = Name
            Else
                .Cells(CurrentRow, 1) = Trim(Mid(TextLine, 1, 19))
                Name = Trim(Mid(TextLine, 1, 19))
            End If
            'EMP
            If Trim(Mid(TextLine, 21, 5)) = "" Then
                .Cells(CurrentRow, 2) = EMP
            Else
                .Cells(CurrentRow, 2) = Trim(Mid(TextLine, 21, 5))
                EMP = Trim(Mid(TextLine, 21, 5))
            End If
            'GRADE
            If Trim(Mid(TextLine, 28, 3)) = "" Then
                .Cells(CurrentRow, 3) = GRD
            Else
                .Cells(CurrentRow, 3) = Trim(Mid(TextLine, 28, 3))
                GRD = Trim(Mid(TextLine, 28, 3))
            End If
            'WORK CENTER
            If Trim(Mid(TextLine, 50, 4)) = "" Then
                .Cells(CurrentRow, 4) = WC
            Else
                .Cells(CurrentRow, 4) = Trim(Mid(TextLine, 50, 4))
                WC = Trim(Mid(TextLine, 50, 4))
            End If
            'COURSE CODE
            If Trim(Mid(TextLine, 55, 6)) = "" Then
            .Cells(CurrentRow, 5) = COURSECODE
            Else
            .Cells(CurrentRow, 5) = Trim(Mid(TextLine, 55, 6))
            COURSECODE = Trim(Mid(TextLine, 55, 6))
            'NARRATIVE
            If Trim(Mid(TextLine, 62, 28)) = "" Then
             .Cells(CurrentRow, 6) = NARRATIVE
             Else
            .Cells(CurrentRow, 6) = Trim(Mid(TextLine, 62, 28))
            NARRATIVE = Trim(Mid(TextLine, 62, 28))
            'STATUS
            If Trim(Mid(TextLine, 96, 6)) = "" Then
            .Cells(CurrentRow, 8) = STATUS
            Else
             .Cells(CurrentRow, 8) = Trim(Mid(TextLine, 96, 6))
             STATUS = Trim(Mid(TextLine, 96, 6))
            End If
            'STATUS DATE
            .Cells(CurrentRow, 9) = STATUSDATE
            STATUSDATE = Trim(Mid(TextLine, 104, 9))
            End If
            'There isn't always a due date so keep going if it's blank
            On Error Resume Next
            'DUE DATE
            .Cells(CurrentRow, 10) = DUEDATE
            DUEDATE = Trim(Mid(TextLine, 114, 9))
            On Error GoTo 0
            'EVENT ID
            If Trim(Mid(TextLine, 124, 7)) = "" Then
                .Cells(CurrentRow, 4) = EVTID
            Else
                .Cells(CurrentRow, 4) = Trim(Mid(TextLine, 124, 7))
                EVTID = Trim(Mid(TextLine, 124, 7))
            End If
           rec.AddNew
             rec.Fields("NAME") = sNAME
             rec.Fields("EMP") = sEMP
             rec.Fields("GRD") = sGRD
             rec.Fields("WC") = sWC
             rec.Fields("COURSE CODE") = sCOURSECODE
             rec.Fields("NARRATIVE") = sNARRATIVE
             rec.Fields("STATUS") = sSTATUS
             rec.Fields("STATUS DATE") = IIf(dSTATUSDATE = #12:00:00 AM#,   vbNull, dSTATUSDATE)
             rec.Fields("DUE DATE") = IIf(dDUEDATE = #12:00:00 AM#, vbNull, dDUEDATE)
             rec.Fields("EVTID") = sEventID
           rec.Update

         Loop
         rec.Close
         db.Close
     Next
  Else
     MsgBox "You clicked Cancel in the file dialog box."
  End If
End With

Exit_Command0_Click:
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE TMA SET TMA.STATUSDATE = """" WHERE (((TMA.STATUSDATE)=#12/31/1899#));"
DoCmd.RunSQL "UPDATE TMA SET TMA.DUEDATE = """" WHERE (((TMA.DUEDATE)=#12/31/1899#));"
DoCmd.SetWarnings True
Exit Sub

Err_Command0_Click:
MsgBox Err.Number & " " & Err.Description & " Check your Excel File for data consistancy with database structure.  Ensure no text in date fields."
End If
 If IsNull(rec) Then
    rec.Close
End If
db.Close
Resume Exit_Command0_Click
End Sub
2
ms-accessvba
HI and welcome to StackOverflow. Please add some code of yours. - Eduard Malakhov
Hello and thank you, I have copied one of my attempts for you. - Sterling

2 Answers

1
votes

I would suggest using the Get External Data - Text File wizard to first import the file manually and save a specification file during the process. You can do this by clicking on the Advanced button upon reaching the last step of the wizard.

Then, use the DoCmd.TransferText method supplied with the name of the import specification that you saved earlier:

DoCmd.TransferText acImportFixed, "YourSavedSpecification", "YourTableName", "YourTextFilename", True

The last argument in this expression determines whether the import should expect your input file to include field names on the first row of the data - set this to false if this is not the case.

0
votes

Without examples of your data file I can't provide any sample code here, so I am going to talk through in psuedo code. Your current approach is to filter the original data file which can be complex. My alternative approach is:

Import your text file (as-is) into a temporary table. 
'// Use some very safe formats so all the text cells come in (e.g. treat all as strings and account for NULL values).
'// doesn't matter if the text in rows you don't care about don't come in cleanly.
Set up a Query to find the rows in this temporary table that meet your filter query.
Use the query result to fill your official table
'// Remember to convert from your safe import format into the data format you want.

This approach can be modularised (e.g. you can have tailored functions for different types of input files). The following shows the logic train (again, not based on executable code):

Function ImportTextFile(InFile as string) As Table
Function FindValidDataRows(TheSource as Table) As Query
Sub AppendtoData(TheQuery as Query)

Yes, the working level code may be similar to what you already have, but the maintainability and extensibility is greatly improved.