ADO With Text Files

[faberk]

I am having problems connecting to text files using ado and im certain its my
syntax. I need two connections for this exercise: 1 to an access database to
write records and another to a group of text files, which will supply me the
data i need to add records to the ms access database.

the routine crashes on this line:
rsTxt.Open "Select * from " & strFileName, cnTxt, adOpenStatic

The following is the entire sub procedure. Thanks for any help in advance

Public Sub refreshReportData()

Dim cnTxt As ADODB.Connection
Dim cnDB As ADODB.Connection
Dim rsTxt As ADODB.Recordset
Dim rsDB As ADODB.Recordset
Dim strSQL As String, strFileName As String
Dim strRptId As String, strRptName As String

On Error GoTo refreshMSAccessData_Error

Set cnTxt = New ADODB.Connection
Set cnDB = New ADODB.Connection
Set rsTxt = New ADODB.Recordset
Set rsDB = New ADODB.Recordset

'Open Access database and recordset (tblReportData)
With cnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & strPathAutoRaw &
"CostExceptionData.mdb;"
.Open
End With
rsDB.Open "tblReportData", cnDB, adOpenKeyset, adLockOptimistic

'delete all records in tblReportData
' rsDD.Delete

'loop through text report extracts and load data into database file
If Dir(strPathAutoCurrent & "*.txt") = "" Then
MsgBox strPathAutoCurrent & "contains no Excel files"
Exit Sub
Else
strFileName = Dir(strPathAutoCurrent & "*.txt")
Do While Len(strFileName) > 0
strRptId = Left(strFileName, 2)
strRptName = Mid(strFileName, 3, Len(Mid(strFileName, 3)) - 4)
'open XL workbook connection and recordset for copy
With cnTxt
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "text;
HDR=Yes;FMT=Delimited"
.ConnectionString = "Data Source=" & strPathAutoCurrent
.Open
End With

If rsTxt.RecordCount <> 0 Then
rsTxt.MoveFirst
Do While Not rsTxt.EOF
rsDB.AddNew
rsDB.Fields(0).Value = strRptId
rsDB.Fields(1).Value = strRptName
rsDB.Fields(2).Value = rsTxt.Fields(0).Value
rsDB.Fields(3).Value = rsTxt.Fields(1).Value
rsDB.Fields(4).Value = rsTxt.Fields(2).Value
rsDB.Fields(5).Value = rsTxt.Fields(3).Value
rsDB.Fields(6).Value = rsTxt.Fields(4).Value
rsDB.Fields(7).Value = rsTxt.Fields(5).Value
rsDB.Fields(8).Value = rsTxt.Fields(6).Value
rsDB.Update
rsTxt.MoveNext
Loop
End If
rsTxt.Close
cnTxt.Close
strFileName = Dir
Loop
End If

On Error GoTo 0
Exit Sub

refreshMSAccessData_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
refreshMSAccessData of Module modPublicMacros"
End Sub

 

[faberk]

My apologies...I was making some changes when i pasted the question.
Repasting the routine and crash point

The routine crashes here when it attempts to make the connection:
rsTxt.Open "Select * from " & strFileName & ";", cnTxt,
adOpenKeyset

'
Public Sub refreshReportData()

Dim cnTxt As ADODB.Connection, cnDB As ADODB.Connection
Dim rsTxt As ADODB.Recordset, rsDB As ADODB.Recordset
Dim strSQL As String, strFileName As String
Dim strRptId As String, strRptName As String

On Error GoTo refreshMSAccessData_Error

Set cnTxt = New ADODB.Connection
Set cnDB = New ADODB.Connection
Set rsTxt = New ADODB.Recordset
Set rsDB = New ADODB.Recordset

'Open Access database and recordset (tblReportData)
With cnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & strPathAutoRaw &
"CostExceptionData.mdb;"
.Open
End With
rsDB.Open "tblReportData", cnDB, adOpenKeyset, adLockOptimistic

'delete all records in tblReportData
' rsDD.Delete

'loop through ext file reports loading data from each into database file
If Dir(strPathAutoCurrent & "*.txt") = "" Then
MsgBox strPathAutoCurrent & "contains no Excel files"
Exit Sub
Else
strFileName = Dir(strPathAutoCurrent & "*.txt")
Do While Len(strFileName) > 0
strRptId = Left(strFileName, 2)
strRptName = Mid(strFileName, 3, Len(Mid(strFileName, 3)) - 4)
'open text file connection and recordset for copy
With cnTxt
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "text;
HDR=Yes;FMT=Delimited"
.ConnectionString = "Data Source=" & strPathAutoCurrent
.Open
End With

rsTxt.Open "Select * from " & strFileName & ";", cnTxt,
adOpenKeyset
If rsTxt.RecordCount <> 0 Then
rsTxt.MoveFirst
Do While Not rsTxt.EOF
rsDB.AddNew
rsDB.Fields(0).Value = strRptId
rsDB.Fields(1).Value = strRptName
rsDB.Fields(2).Value = rsTxt.Fields(0).Value
rsDB.Fields(3).Value = rsTxt.Fields(1).Value
rsDB.Fields(4).Value = rsTxt.Fields(2).Value
rsDB.Fields(5).Value = rsTxt.Fields(3).Value
rsDB.Fields(6).Value = rsTxt.Fields(4).Value
rsDB.Fields(7).Value = rsTxt.Fields(5).Value
rsDB.Fields(8).Value = rsTxt.Fields(6).Value
rsDB.Update
rsTxt.MoveNext
Loop
End If
rsTxt.Close
cnTxt.Close
strFileName = Dir
Loop
End If

On Error GoTo 0
Exit Sub

refreshMSAccessData_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
refreshMSAccessData of Module modPublicMacros"
End Sub