Avatar of mytfein
mytfein
 asked on

Access 2003: importing txt file into Access, (my working approach has a flaw....)

Hi EE,

About 10 years ago, i got help from the Internet to import a txt file into Access.

i imported the txt file into and Access table via Excel as the "middleman"

using vba:

a) launched excel
b) opentext command, using array to map the data to columns
c) inserted a first row, to assign columns name
d) import spreadsheet to excel file using: DoCmd.TransferSpreadsheet

THE PROBLEM with the above approach is step (d)

i have a numeric column with the patient id# that has grown from 6 characters to 7 character.

i get the text file from a mainframe file, of the prior day's patient registrations.

the id# column can have 7 digits for brand new patients
the id# column can have 6 digits for old             patients

the problems is that the transfer spreadsheet command, DROPS OFF THE LAST NUMBER
on the 7 digit and imports only 6 numbers.

so 1234567  got imported as 123456

my logic updated an exisitng 123456 record incorrectly
     

(so i have 2 issues:  using backup data, reupdate the 123456 old employee
                                fix the import logic for future)

we turned off the vba script until all issues are fixed

uploaded a zip file containing the txt file and mdb file  

the txt file as 2 test records, first one has id of 7 numbers
                                              second one has id of 6 numbers

the table it gets imported to is:
                          w_000_eagleEHSvisits

pls note how the field: patientNumber  the last digit of first record is truncated

====
do the EE experts have a better approach....

pls advise.... tx so much, sandra

======

code is below:


Option Compare Database

Option Explicit

Dim objExcel                     As Excel.Application
Dim objExcelActiveWkb            As Excel.Workbook
Dim objExcelActiveWS            As Excel.Worksheet

Dim blnExcelAlreadyRunning       As Boolean


Public Sub a002_ImportEagleDownload(strBackDataDate As String)

LaunchExcel

' ImportTextToExcel2 ("c:\EHS_eagledownload\old_EHSPMM2.TXT")
'ImportTextToExcel2 ("c:\EHS_eagledownload_front\EHSPMM_Dec.TXT")

Debug.Print CurrentProject.Path

ImportTextToExcel2 (CurrentProject.Path & "\EHSPMM.TXT")

SaveExcelSpreadsheet

CloseExcel (True)

ImportSpreadsheetToAccess


' att: EE expert:
' commented out processing.... pls check table:  w_000_eagleEHSvisits
' to see how first record: the last digit got dropped on the import

'                  b005_ProcessEagle (strBackDataDate)

End Sub

'=======================================
Private Sub LaunchExcel()
On Error Resume Next

If WasExcelRunningBeforeThisExecution Then
   blnExcelAlreadyRunning = True
    Set objExcel = GetObject(, "Excel.Application")
Else
    blnExcelAlreadyRunning = False
    Set objExcel = CreateObject("Excel.Application")
End If

 objExcel.Visible = True   'False
       
End Sub

'==========================================
Public Function WasExcelRunningBeforeThisExecution() As Boolean

On Error Resume Next

Set objExcel = GetObject(, "Excel.Application")

WasExcelRunningBeforeThisExecution = (Err.Number = 0) ' if err.number = 0, true else false
Debug.Print Err.Number
Debug.Print Err.Description


Err.Clear

End Function


'====================================
Public Sub SaveExcelSpreadsheet()

On Error GoTo SaveExcelSpreadsheet_Err

Dim strPath As String
   
strPath = CurrentProject.Path & "\EagleEhsVisits.xls"
   
Kill strPath

Set objExcelActiveWkb = objExcel.ActiveWorkbook

objExcelActiveWkb.SaveAs FileName:=strPath, FileFormat:=xlNormal
objExcelActiveWkb.Save

objExcel.DisplayAlerts = False
objExcelActiveWkb.Close savechanges:=False
objExcel.DisplayAlerts = True

Set objExcelActiveWS = Nothing
Set objExcelActiveWkb = Nothing

SaveExcelSpreadsheet_Exit:
     Exit Sub
   
SaveExcelSpreadsheet_Err:
     Select Case Err.Number
       
         Case 53     ' kill didn't find the file - ignore error
            'MsgBox Err.Number & "  " & Err.Description
            Resume Next
           
         Case Else
            MsgBox "Error # " & Err.Number & ": " & Err.Description
            Resume SaveExcelSpreadsheet_Exit
           
       End Select


End Sub

'==================================
Public Sub CloseExcel(blnHowToCloseExcel As Boolean)

On Error GoTo CloseExcel_Err


' objExcelActiveWkb.Close savechanges:=False
 
objExcel.DisplayAlerts = False
If Not blnExcelAlreadyRunning Then
    objExcel.Quit
End If
objExcel.DisplayAlerts = True

CloseExcel_Exit:
'    Set objExcelActiveWkb = Nothing
    Set objExcel = Nothing

   
    Exit Sub
   
CloseExcel_Err:
    MsgBox "Error # " & Err.Number & ": " & Err.Description
    Resume CloseExcel_Exit
 
   
End Sub




'       Filename:="C:\EHSPMMt.TXT", Origin:=xlWindows, StartRow _
'====
Public Sub ImportTextToExcel2(strFileName As String)

' FileName:="c:\EHS_eagledownload\old_EHSPMM2.TXT", _

 objExcel.Workbooks.OpenText _
       FileName:=strFileName, _
       Origin:=xlWindows, StartRow _
        :=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(7, 2), Array(13, 2), Array(19, 2), Array(25, 2), Array(31, 2), Array _
        (45, 2), Array(52, 1), Array(60, 2), Array(86, 2), Array(121, 2), Array(146, 2), Array(150, _
        2), Array(152, 2), Array(161, 2), Array(163, 2), Array(174, 2), Array(186, 2), Array(197, 2 _
        ), Array(207, 2), Array(208, 2), Array(209, 2), Array(210, 2), Array(212, 2), Array(214, 2) _
        , Array(221, 2), Array(222, 2), Array(235, 2), Array(247, 2), _
        Array(250, 2), Array(262, 2), Array(273, 2), _
        Array(298, 2), Array(300, 2), Array(310, 2), Array(320, 2), Array(328, 2), Array(329, 2), _
        Array(330, 2), Array(334, 2), Array(340, 2), Array(341, 2), Array(370, 2), Array(396, 2), Array(399, 2), Array(416, 2), _
        Array(481, 2), Array(499, 2), Array(516, 2), Array(517, 2), Array(518, 2), _
        Array(519, 2), Array(520, 2), Array(521, 2), _
        Array(522, 2))
       
       
' Exit Sub

Set objExcelActiveWS = objExcel.ActiveSheet

With objExcelActiveWS

           With .Rows("1:1")
              .Select
              .EntireRow.Insert
           End With
           
            Dim lngColumnCount As Long
            lngColumnCount = 0

             lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "header"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "headerDate"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "headerTime"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "fillera"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "recordID"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler1"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "patientNumber"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler2"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientName"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientStreet"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientCity"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientCounty"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientState"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientZip"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatienCountry"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler3"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientPhone"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientSSn"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "PatientDOB"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "G1"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "M1"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler4"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "R1"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Rel"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Chart#"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "E1"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Medicare#"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Medicaid#"
             
                           
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Elig"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "ARind"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "MothersName"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler8"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler9"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler10"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler11"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler12"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "UHB_friend"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler14"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler15"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler16"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler17"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler18"
             
                           
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "AddrLine2"
             
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "Home2"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "BusinessPhone"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler20"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler21"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler22"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler23"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler24"
                                                                                           
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "TYPE"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler25"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler26"
                                                                                           
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "filler27"
             
              lngColumnCount = lngColumnCount + 1
              .Cells(1, lngColumnCount).Value = "UDATE"

 
     With .Cells
          .Select
          .EntireColumn.AutoFit
     End With

   
 
 
End With
 
 
End Sub


Public Sub ImportSpreadsheetToAccess()


Dim strExcelFile As String
Dim strTableName As String

Dim strSql       As String

strExcelFile = CurrentProject.Path & "\EagleEhsVisits.xls"
strTableName = "W_000_EagleEhsVisits"
       
strSql = "DELETE FROM " & strTableName
CurrentDb.Execute (strSql)

DoCmd.TransferSpreadsheet _
      TransferType:=acImport, _
      SpreadsheetType:=8, _
      TableName:=strTableName, _
      FileName:=strExcelFile, _
      HasFieldNames:=True

End Sub


<Mod edit: for the sample database file, please see http:#a39052308>
ehspmm.txt
Microsoft Access

Avatar of undefined
Last Comment
mytfein

8/22/2022 - Mon
Rey Obrero (Capricorn1)

upload a copy of the text file, EHSPMM.TXT
mytfein

ASKER
hi cap,

tx for writing....

its uploaded above, with the mdb as 2 sep files

tx, s
ASKER CERTIFIED SOLUTION
Rey Obrero (Capricorn1)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
mytfein

ASKER
hi cap,

thats the answer

your're brilliant

tx so much
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
mytfein

ASKER
hi cap,

i tried so hard to create test tables of test data

i just realized that one table has real info

so pls can you delete the mdb from your pc

i will ask the moderator if he can replace the mdb with a diff one where i deleted the real
data.....

tx again, s
Rey Obrero (Capricorn1)

np..
mytfein

ASKER
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.