Code:
Private Sub Command0_Click()
Dim myBodyTextFile As New clsReadTextFile
Dim myString As String
Dim intError As Integer
Dim curDatabase As DAO.Database
Dim rstHeader As DAO.Recordset
Dim intCtr As Integer
intCtr = 0
If Me.CheckImportLive = True Then
myBodyTextFile.FileName = "T:\NJ\VHEADER.MS"
Else
myBodyTextFile.FileName = "T:\COPYOF~1\VHEADER.MS"
End If
myBodyTextFile.FixedWidthLineLength = 512
intError = myBodyTextFile.cfOpenFile
If intError = 0 Then
Set curDatabase = CurrentDb
Set rstHeader = curDatabase.OpenRecordset("VHEADER")
myBodyTextFile.csGetALine
Do While Not myBodyTextFile.EndOfFile
Temp = SysCmd(acSysCmdSetStatus, "Bytes To Process: " & myBodyTextFile.BytesLeft)
intCtr = intCtr + 1
If Left(myBodyTextFile.Text, 1) <> "" Then
rstHeader.AddNew
rstHeader("APTS").Value = Mid(myBodyTextFile.Text, 1, 4)
rstHeader("BLDGAKA").Value = Mid(myBodyTextFile.Text, 5, 30)
rstHeader("BLDGCITY").Value = Mid(myBodyTextFile.Text, 35, 20)
rstHeader("BLDGNAME").Value = Mid(myBodyTextFile.Text, 55, 30)
rstHeader("BLDGNO").Value = Mid(myBodyTextFile.Text, 85, 3)
rstHeader("BLDGSTRNAM").Value = Mid(myBodyTextFile.Text, 88, 25)
rstHeader("BLDGSTRNUM").Value = Mid(myBodyTextFile.Text, 113, 10)
rstHeader("BLDGUSE").Value = Mid(myBodyTextFile.Text, 123, 1)
rstHeader("BLDGZIP").Value = Mid(myBodyTextFile.Text, 124, 9)
rstHeader("BLOCK").Value = Mid(myBodyTextFile.Text, 133, 6)
rstHeader("CARDCODE").Value = Mid(myBodyTextFile.Text, 139, 1)
rstHeader("COMUCODE").Value = Mid(myBodyTextFile.Text, 140, 4)
rstHeader("CONDITION").Value = Mid(myBodyTextFile.Text, 144, 1)
rstHeader("CONTPHONE").Value = Mid(myBodyTextFile.Text, 145, 12)
rstHeader("ENDDATE").Value = Mid(myBodyTextFile.Text, 157, 8)
rstHeader("ENDTIME").Value = Mid(myBodyTextFile.Text, 165, 6)
rstHeader("INSPCODE").Value = Mid(myBodyTextFile.Text, 171, 2)
rstHeader("INSPCOMP").Value = Mid(myBodyTextFile.Text, 173, 1)
rstHeader("INSPNAME").Value = Mid(myBodyTextFile.Text, 174, 30)
rstHeader("KY1INSPINT").Value = Mid(myBodyTextFile.Text, 204, 3)
rstHeader("KY2BEGDATE").Value = Mid(myBodyTextFile.Text, 207, 8)
rstHeader("KY3BEGTIME").Value = Mid(myBodyTextFile.Text, 215, 8)
rstHeader("LOT").Value = Mid(myBodyTextFile.Text, 223, 6)
rstHeader("NEWREGNO").Value = Mid(myBodyTextFile.Text, 229, 14)
rstHeader("OLDREGNO").Value = Mid(myBodyTextFile.Text, 243, 6)
rstHeader("OWNERADD").Value = Mid(myBodyTextFile.Text, 249, 35)
rstHeader("OWNERCITY").Value = Mid(myBodyTextFile.Text, 284, 20)
rstHeader("OWNERNAME").Value = Mid(myBodyTextFile.Text, 304, 60)
rstHeader("OWNERPHONE").Value = Mid(myBodyTextFile.Text, 364, 12)
rstHeader("OWNERSTATE").Value = Mid(myBodyTextFile.Text, 376, 2)
rstHeader("OWNERZIP").Value = Mid(myBodyTextFile.Text, 378, 9)
rstHeader("PROJCODE").Value = Mid(myBodyTextFile.Text, 387, 6)
rstHeader("PROJCOMP").Value = Mid(myBodyTextFile.Text, 393, 1)
rstHeader("PROJLEADER").Value = Mid(myBodyTextFile.Text, 394, 1)
rstHeader("PROMPTQUES").Value = Mid(myBodyTextFile.Text, 395, 10)
rstHeader("RECNUM") = intCtr
rstHeader("STORIES").Value = Mid(myBodyTextFile.Text, 405, 2)
rstHeader("SUPERINIT").Value = Mid(myBodyTextFile.Text, 407, 3)
rstHeader("TOTALBLDG").Value = Mid(myBodyTextFile.Text, 410, 3)
rstHeader("TOTALUNITS").Value = Mid(myBodyTextFile.Text, 413, 4)
rstHeader("TYPECONST").Value = Mid(myBodyTextFile.Text, 417, 1)
rstHeader("UNITCOUNT").Value = Mid(myBodyTextFile.Text, 418, 4)
rstHeader("UNITS").Value = Mid(myBodyTextFile.Text, 422, 4)
rstHeader.Update
End If
myBodyTextFile.csGetALine
Loop
myBodyTextFile.cfCloseFile
rstHeader.Close
Set rstHeader = Nothing
Set curDatabase = Nothing
MsgBox "DONE"
Temp = SysCmd(acSysCmdClearStatus)
Else
MsgBox "ERROR"
End If
End Sub
I tried this on a Windows 7/Access 2010 machine and it exhibits the same behavior.