Import fixed width text file using VBA into MS Access - ms-access

Question

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

Answer 1

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.

Answer 2

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.