troubleshooting Question

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

Avatar of mytfein
mytfein asked on
Microsoft Access
7 Comments1 Solution365 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 7 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 7 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros