-
vb gurus,
i am trying to create an application that will import a text file and then parse the information into a table. i'm using vb6 and ado 2.1. my thought was to create a connection to the file and then opening it into a recordset. i added a messagebox that gives me the the recordcount and absoluteposition of the recordset though i cannot figure out where it is getting its values (absoluteposition = -1 and recordcount = 145). though this approach does not seem to be working, it still should be a viable way to go. any help would be greatly appreciated. i attached my code below.
Public Sub Parse()
'create a counter
Dim i As Integer
i = 1
'reformat common dialog box
cdlBics2.Enabled = True
cdlBics2.Filter = "*.dat"
cdlBics2.FileName = "*.dat"
cdlBics2.Value = 1
cdlBics2.DialogTitle = "Select Print File"
strFile = cdlBics2.FileName
'copy file selected above to print.txt
FileCopy strFile, "m:\sleeping bear\print.txt"
'-----------------------------------------------------------
'establish a connection to print.txt and create a
'recordset
Dim strConPrint As String
Dim conPrint As New ADODB.Connection
strConPrint = "Provider=MSDASQL;" & _
"Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DBQ=m:\sleeping bear"
conPrint.Open strConPrint
Set rsPackingSlip0 = New ADODB.Recordset
rsPackingSlip0.Open "print.txt", conPrint, adOpenStatic, adLockReadOnly
'-----------------------------------------------------------
'-----------------------------------------------------------
'this block of code is temporary. it allows me to see that
'everything is going ok (or more accurately, not going ok)
With rsPackingSlip0
If rsPackingSlip0.EOF = True And rsPackingSlip0.BOF = True Then
MsgBox "Empty"
Else
MsgBox "recordcount = " & .RecordCount & vbCrLf & _
"position = " & .AbsolutePosition & vbCrLf
End If
End With
'-----------------------------------------------------------
'create new recordset that will take the info from the
'previous recordset and parse it to the new table.
sqlPackingSlip1 = "SELECT * FROM tblPackingSlip1"
Set rsPackingSlip1 = New ADODB.Recordset
rsPackingSlip1.Open sqlPackingSlip1, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
Do Until i = 0
rsPackingSlip1.AddNew
rsPackingSlip1.Fields(0) = ParseString & _
(rsPackingSlip0.Fields(0), "Pag Custome ", i)
rsPackingSlip1.Update
i = i + 1
Loop
End Sub
-
I don't see where your I variable would ever be zero, so it looks like there might be an endless loop there.
Also, don't rely on the ODBC driver to accurately give you a recordcount and absolute position, you're better off opening a recordset and looping until EOF.
What specific problem are you having here?
-
i was unable to read any data from the recordset that supposedly contains the text file. i tried displaying the data in a messagebox with:
msgbox rsPackingSlip0.Fields(0)
however, i am told that rsPackingSlip0.Fields(0) is an empty string.
after i originally made this post, however, i tried a different tack. i used:
Dim strPrint As String
Dim strPrint2 As String
Open "m:\sleeping bear\print.txt" For Input As #1
Input #1, strPrint
strPrint2 = strPrint & vbCrLf
Do Until (EOF(1) = True)
Input #1, strPrint
strPrint2 = strPrint2 & strPrint & vbCrLf
Loop
this has worked well, but i would still like to know why my original method didn't work.
-
TRY THIS MAN, SORT OF WORKS BUT I'M NEW TO VB SO ITS PROBABLY REALLY CRAP
Option Explicit
Private Sub Form_Load()
Dim FileName As String
Dim FileNumber As Integer
Dim Data As String
Dim DirPath As String
Dim FileSpec As String
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim FindNextHandle As Long
Dim filestring As String
Dim TotalFiles As Integer
Dim Arraypos As Integer, i As Integer
Dim ClientName As String, DateOfCall As String, CallTerminator As String, CallDuration As String, CallValue As String
Dim Count As Integer
77
Dim DBconnect As Database
TotalFiles = 0
Count = 0
'On Error Resume Next
DirPath = "D:\ftp-acquist test files\"
FileSpec = "*.*"
FindHandle = FindFirstFile(DirPath & FileSpec, FindData)
' LOOP THROUGH FILES
'If FindHandle <> 0 Then
Do
DoEvents
FindNextHandle = FindNextFile(FindHandle, FindData)
If FindNextHandle <> 0 Then
If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
' It 's a directory
If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
filestring = DirPath & Trim$(FindData.cFileName) & "\"
End If
Else
filestring = DirPath & Trim$(FindData.cFileName)
TotalFiles = TotalFiles + 1
End If
Else
Exit Do
End If
Loop
'End If
ReDim FileNames(1 To TotalFiles) As String
DirPath = "D:\ftp-acquist test files\"
FileSpec = "*.*"
FindHandle = FindFirstFile(DirPath & FileSpec, FindData)
Do
DoEvents
FindNextHandle = FindNextFile(FindHandle, FindData)
If FindNextHandle <> 0 Then
If FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
' It 's a directory
If Left$(FindData.cFileName, 1) <> "." And Left$(FindData.cFileName, 2) <> ".." Then
filestring = DirPath & Trim$(FindData.cFileName) & "\"
End If
Else
Arraypos = Arraypos + 1
FileNames(Arraypos) = DirPath & Trim$(FindData.cFileName)
End If
Else
Exit Do
End If
Loop
For i = 1 To TotalFiles
Count = 0
FileName = FileNames(i)
FileNumber = FreeFile
Open FileName For Input Access Read As #FileNumber
Do Until EOF(FileNumber)
Count = Count + 1
Line Input #FileNumber, Data ' Read a line
Select Case Count
Case 1
ClientName = Data
Case 2
DateOfCall = Data
Case 4
CallTerminator = Data
Case 5
CallDuration = Data
Case 6
CallValue = Data
End Select
Loop
Close #FileNumber
Call modsearch.WriteToDB(ClientName, DateOfCall, CallTerminator, CallDuration, CallValue)
Next i
End Sub
Private Sub cmdAddRecord_Click()
Dim DBconnect As Database
Dim Query As String
Dim Store As String
Dim Var As String
Dim Result As Recordset
'connect to database
Set DBconnect = OpenDatabase("D:\AcquistTestOld\Acquist_data.mdb")
'Standard Query
Query = "INSERT INTO Acquist_data (ClientName, DateOfCall, CallTerminator, CallDuration, CallValue ) Values('" & ClientName & "','" & DateOfCall & "','" & CallTerminator & "','" & CallDuration & "','" & CallValue & "')"
DBconnect.Execute (Port1_Query)
End Sub
THIS IS THE MODULE I USED:
Option Explicit
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Const MAX_PATH = 260
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Sub WriteToDB(pName As String, pDateOfCall As String, pTerminator As String, pDuration As String, pValue As String)
Dim DBconnect As Database
Dim Query As String
Dim Resultset As Recordset
'connect to database
Set DBconnect = OpenDatabase("D:\AcquistTestOld.mdb")
'Standard Query
Query = "INSERT INTO Acquist_data(ClientName, CallDate, CallTerminator, CallDuration, CallValue) VALUES ('" & pName & "' , '" & pDateOfCall & "', '" & pTerminator & "', '" & pDuration & "', '" & pValue & "')"
DBconnect.Execute (Query)
End Sub
