Import "Unique Text file" using VBA and updating Access Table

Question

Good day,

I am a novice developer who tries in my spare time to make my job easier.  I've been attempting to study and read VBA and I'm not connecting all the dots/information, yet, with figuring out a way to import a text file that is produced from a unique system.  The system is old and the text file was designed for printing.  I do not want all the data, but, to select the data and import into a table.  I have the code to import the same text into an Excel product, but, I use Access, and it would make my job so much easier, and easier for non-users, if I could just import the text into the database and run from there.

Here is a sample of my Excel VBA code, that I use:

'Parses the AAA text file into the spreadsheet
Function AAA()
Cells.Select
Selection.Clear
Repeat:
    Dim TextLine As String, CurrentRow As Integer, MemberName As String
    Dim EmployeeNumber As String, Grade As String, DAFSC As String, PAFSC As String
    Dim WC As String, x As Integer, CrsCode As String, NARRATIVE As String, Status As String
    Dim StatusDate As String, DueDate As String, EvtID As String, DURINTVL As String
    Dim lngCount As Long, FileLocation As String, Response As Integer

UserForm1.Show

'GoTo here
    'Prompt for text file location
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = GetSetting("AAA Parser", "User Settings", "Default Open Path")
        .Filters.Add "Text files", "*.txt", 1
        .Show
        If .SelectedItems.Count = 0 Then Exit Function
        FileLocation = .SelectedItems(.SelectedItems.Count)
    End With
    If FileLocation = "" Then Exit Function
    SaveSetting "AAA Parser", "User Settings", "Default Open Path", FileLocation
    
    'Open the specified AAA text file
    Open FileLocation For Input As #1
'    Open FileLocation & ".txt" For Output As #2
    With Sheet1
        'Set the font for the header row
        For x = 1 To 13
            .Cells(1, x).Font.Name = "Courier New"
            .Cells(1, x).Interior.Color = RGB(192, 192, 192) 'grey
        Next x
        'Set column headings
        .Cells(1, 1) = "'NAME"
        .Cells(1, 2) = "'EMP"
        .Cells(1, 3) = "'GRD"
        .Cells(1, 4) = "'DAFSC"
        .Cells(1, 5) = "'PAFSC"
        .Cells(1, 6) = "'W/C"
        .Cells(1, 7) = "'CRSCODE"
        .Cells(1, 8) = "'NARRATIVE"
        .Cells(1, 9) = "'DUR/INTVL"
        .Cells(1, 10) = "'STATUS"
        .Cells(1, 11) = "'STATUS DATE"
        .Cells(1, 12) = "'DUE DATE"
        .Cells(1, 13) = "'EVENT ID"
        
    End With
    'Go to row 2
    CurrentRow = 2
    'Loop through all lines of the text file
    Do While Not EOF(1)
        Line Input #1, TextLine
        'If this is a data line then...
        Debug.Print Trim(Mid(TextLine, 114, 9))
        If Mid(TextLine, 20, 1) = " " And _
            Mid(TextLine, 27, 1) = " " And _
            Mid(TextLine, 33, 1) = " " And _
            Mid(TextLine, 41, 1) = " " And _
            Mid(TextLine, 49, 1) = " " And _
            Mid(TextLine, 54, 1) = " " And _
            Mid(TextLine, 61, 1) = " " And _
            Mid(TextLine, 90, 1) = " " And _
            Mid(TextLine, 95, 1) = " " And _
            Mid(TextLine, 103, 1) = " " And _
            TextLine <> "" Then

How can I manipulate the VBA code, to use in "Access" and update a table in the database?

Below is a sample of my text report and how it is formatted.  Hopefully it helps.  (I sometimes have over a 100 pages, and the Excel VBA code works great)

                                                                                 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

Answer 1

Hello Sterling Silver,

Importing data from Excel to Access will be much easier that importing data from Text file to Access, since you could successfully export Text file data to Excel, I would suggest you continue your code to import data from a saved workbook to Access.

Although you said update a table in the database, but according to your operation on the Excel, you are importing new data and deleted all the previous data. So the code in Access maybe something like.

Function AAA()
Repeat:
    Dim TextLine As String, CurrentRow As Integer, MemberName As String
    Dim EmployeeNumber As String, Grade As String, DAFSC As String, PAFSC As String
    Dim WC As String, x As Integer, CrsCode As String, NARRATIVE As String, Status As String
    Dim StatusDate As String, DueDate As String, EvtID As String, DURINTVL As String
    Dim lngCount As Long, FileLocation As String, Response As Integer
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    Set xlWs = xlWB.Sheets(1)
    saveFileName = "C:\Users\terryx\Desktop\ForTesting.xlsx"

'UserForm1.Show

'GoTo here
    'Prompt for text file location
    With xlApp.FileDialog(1)
        .InitialFileName = GetSetting("AAA Parser", "User Settings", "Default Open Path")
        .Filters.Add "Text files", "*.txt", 1
        .Show
        If .SelectedItems.Count = 0 Then Exit Function
        FileLocation = .SelectedItems(.SelectedItems.Count)
    End With
    If FileLocation = "" Then Exit Function
    SaveSetting "AAA Parser", "User Settings", "Default Open Path", FileLocation

    'Open the specified AAA text file
    Open FileLocation For Input As #1
'    Open FileLocation & ".txt" For Output As #2
    With xlWs
        'Set the font for the header row
        For x = 1 To 13
            .Cells(1, x).Font.Name = "Courier New"
            .Cells(1, x).Interior.Color = RGB(192, 192, 192) 'grey
        Next x
        'Set column headings
        .Cells(1, 1) = "'NAME"
        .Cells(1, 2) = "'EMP"
        .Cells(1, 3) = "'GRD"
        .Cells(1, 4) = "'DAFSC"
        .Cells(1, 5) = "'PAFSC"
        .Cells(1, 6) = "'W/C"
        .Cells(1, 7) = "'CRSCODE"
        .Cells(1, 8) = "'NARRATIVE"
        .Cells(1, 9) = "'DUR/INTVL"
        .Cells(1, 10) = "'STATUS"
        .Cells(1, 11) = "'STATUS DATE"
        .Cells(1, 12) = "'DUE DATE"
        .Cells(1, 13) = "'EVENT ID"
    End With
    'Go to row 2
    CurrentRow = 2
    'Loop through all lines of the text file
    Do While Not EOF(1)
        Line Input #1, TextLine
        'I dont get all your code, for testing, I hard-coded below code
        'you could adjust it to your previous code
        If _
            TextLine <> "" Then
            With xlWs
            .Cells(CurrentRow, 1) = "'Name" & CurrentRow
            .Cells(CurrentRow, 2) = "'EMP" & CurrentRow
            .Cells(CurrentRow, 3) = "'GRD" & CurrentRow
            .Cells(CurrentRow, 4) = "'DAFSC" & CurrentRow
            .Cells(CurrentRow, 5) = "'PAFSC" & CurrentRow
            .Cells(CurrentRow, 6) = "'W/C" & CurrentRow
            .Cells(CurrentRow, 7) = "'CRSCODE" & CurrentRow
            .Cells(CurrentRow, 8) = "'NARRATIVE" & CurrentRow
            .Cells(CurrentRow, 9) = "'DUR/INTVL" & CurrentRow
            .Cells(CurrentRow, 10) = "'STATUS" & CurrentRow
            .Cells(CurrentRow, 11) = "'STATUS DATE" & CurrentRow
            .Cells(CurrentRow, 12) = "'DUE DATE" & CurrentRow
            .Cells(CurrentRow, 13) = "'EVENT ID" & CurrentRow
            CurrentRow = CurrentRow + 1
            End With
       End If
    Loop
    Close #1
    xlWB.SaveAs saveFileName
    xlWB.Close
    xlApp.Quit
    Set xlWB = Nothing
    Set xlApp = Nothing
    
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "ImportData", saveFileName, True
End Function

Best Regards,

Terry

---

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact [e-mail].

Answer 2

Good day Terry and thank you.

That solution/code provided great results.  It worked better than I imagined.

I have only one "minor" problem that I encountered when using.  One of my columns is a date/time data type.  It’s labeled “STATUSDATE.”  However, there are times when the text report may have the word “NONE” in the field rather than a date or null.

When I use my VBA code in the Excel product, it obviously doesn’t have a problem, (it imports all the data from the text,) but, MS Access date/time data type fields are more restrictive, and it’s not importing rows of data where there is the word “NONE” in the field labeled “STATUSDATE,” which is a date/time data type.

I’ve tried using short text data type, in my table, labeling Dim as String for “STATUSDATE,” which works, but, then I can’t take advantage of the data that are dates.  Access won’t recognize them as dates.

Any suggestions on how to force Access to accept the “NONE” in this field, if it is a date/time data type?

Thank you again for what you have provided.

Sterling

Answer 3

Hi Sterling,

Pardon me for jumping in... You can approach this problem with empty dates from both directions. You can keep them as Text and use the CDate() function to convert the date values into actual dates Access can understand, or you can keep your data as dates in the table and leave the NONEs as Nulls in the table. You can then use the IsDate() or IsNull() function to display "None" if you need to.

Just my 2 cents...