none
Import "Unique Text file" using VBA and updating Access Table RRS feed

  • 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

    Tuesday, June 12, 2018 8:03 PM

Answers

  • 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 MSDNFSF@microsoft.com.

    Wednesday, June 13, 2018 3:00 AM

All replies

  • 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 MSDNFSF@microsoft.com.

    Wednesday, June 13, 2018 3:00 AM
  • 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

    Thursday, June 14, 2018 4:06 PM
  • 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...

    Thursday, June 14, 2018 4:31 PM