How to write data from database into text file

[dojek]

Hello guys..

I'm new here and hopefully someone will help me to solve this problem, i create one program which read data from MYSQL database and write it into text file, the problem is that it works fine for certain record, but for some record, it will write the same record repeatedly(loop forever). For u'r info i have hard coded the name and the length of each field after i failed to code how to get the size of each field and size of remaining field size after it was fill up by data. The remarks@comment sign is my previous code. I really hope that someone can help me to correct this code, or if someone has other solution on how to write data form database into text file, please let me know..

'---------CODE START---------------------
Public Function StartExport() As Boolean
On Error Resume Next

Dim tRs As ADODB.Recordset
Dim tRecCtr, tFldCount, tRecordCount, tCtr, tProgress As Integer
Dim tStr, jenny, strContents, Filename As String
Dim tHashTotal As Integer
Dim temp

If icbalib.CheckSecurity(Me) = False Then
StartExport = False
Exit Function
End If
Screen.MousePointer = 11

Set tRs = New ADODB.Recordset
tRs.CursorLocation = adUseClient
tRs.CursorType = adOpenStatic
tRs.LockType = adLockPessimistic
tRs.Source = "SELECT * FROM TRANS WHERE UPDHOST<>'Y'"
tRs.ActiveConnection = mylib.ADO_Connection
tRs.Open

If tRs.RecordCount = 0 Then
MsgBox "No Record found", vbCritical, App.Title
Screen.MousePointer = 0
tRs.Close
StartExport = False
Exit Function
End If

tStr = ""
Filename = Trim(Me.txtFilename.Text)
tRecCtr = tRs.RecordCount
tHashTotal = 0
Me.ProgressBar1.Value = 0
Me.ProgressBar1.Max = tRecCtr
tProgress = tRecCtr / 100
If tProgress < 1 Then
tProgress = 1
End If

tFldCount = tRs.Fields.Count
tRecordCount = 0

MsgBox tFldCount & " " & tRecCtr

Open Filename For Output As #1
tRs.MoveFirst

'For tCtr = 0 To tFldCount - 1
' tStr = tStr & Trim(tRs.Fields(tCtr).Name) & String(tRs.Fields(tCtr).DefinedSize, " ") & Chr(9)
'Next tCtr
'
'Print #1, tStr
tStr = ""
'While tRs.EOF = False

For tRecordCount = 0 To tRecCtr - 1

For tCtr = 0 To tFldCount - 1

'Characters
Select Case tRs.Fields(tCtr).Type
'VARCHAR, CHAR
Case adVarChar, adChar
'MsgBox "VARCHAR" & tRs.Fields(tCtr) DefinedSize & " " & tRs.Fields(tCtr).ActualSize, vbOKOnly


tStr = tStr & Trim(tRs.Fields(tCtr).Value) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)

'INTEGERS
'cannot use DefineDSize and ActualSize for integer, boolean datatype
'if someone alter TRANS table, this area of code must me updated as well.

Case adInteger, adUnsignedInt

'MsgBox "INTEGER" & tRs.Fields(tCtr).DefinedSize & " " & tRs.Fields(tCtr).ActualSize, vbOKOnly
'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)
Select Case tRs.Fields(tCtr).Name

'SIZE EQUAL TO 6
Case "SEQNO", "ACNO", "ACNO2", "SEQCNT", "REFSEQNO"
tStr = tStr & Right(Space(6) & Trim(Str(tRs.Fields(tCtr).Value)), 6)


'SIZE EQUAL TO 2
Case "CHKDGT", "FLTDAY", "CHKDGT2"
tStr = tStr & Right(Space(2) & Trim(Str(tRs.Fields(tCtr).Value)), 2)

'SIZE EQUAL TO 3
Case "TENOR"
tStr = tStr & Right(Space(3) & Trim(Str(tRs.Fields(tCtr).Value)), 3)

'SIZE EQUAL TO 4
Case "YEAR"
tStr = tStr & Right(Space(4) & Trim(Str(tRs.Fields(tCtr).Value)), 4)

Case Else
MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & ".. Please contact administrator", vbCritical, App.Title
'tStr = tStr & Right(Space(tRs.Fields(tCtr).DefinedSize) & Trim(tRs.Fields(tCtr).Value), tRs.Fields(tCtr).Properties.Count)

End Select

'FLOAT
Case adSingle, adDouble
'If tRs.Fields(tCtr).Name = "TRNAMT" Then
'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(16 - Len(Trim(Str(tRs.Fields(tCtr).Value))), " ") '& Chr(9)

'tHashTotal = tHashTotal + ComputeHash(tRs.Fields(tCtr).Value)
'Else
'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)

'End If

Select Case tRs.Fields(tCtr).Name

'SIZE EQUAL TO (16,2) 19
Case "TRNAMT"
tStr = tStr & Right(Space(19) & Trim(Str(tRs.Fields(tCtr).Value)), 19)

'SIZE EQUAL TO (12,2) 15
Case "COMAMT", "CLRCOM"
tStr = tStr & Right(Space(15) & Trim(Str(tRs.Fields(tCtr).Value)), 15)

'SIZE EQUAL TO (10,2) 13
Case "CHARGES"
tStr = tStr & Right(Space(13) & Trim(Str(tRs.Fields(tCtr).Value)), 13)

Case Else
MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & " Please contact administrator", vbCritical, App.Title
End Select

'DATE
Case adDBDate, adDBTimeStamp

Select Case tRs.Fields(tCtr).Name

'SIZE EQUAL TO DATE 10
Case "UPDDT", "TRNDT"

temp = Format(Trim(Str(tRs.Fields(tCtr).Value)), "dd/mm/yyyy")

'tStr = tStr & Right(Space(10) & "0" & Trim(Str(tRs.Fields(tCtr).Value)), 10)
tStr = tStr & Right(Space(10) & temp, 10)

'SIZE EQUAL TO TIMESTAMP 19
Case "COMAMT", "TRNTIME"

temp = Format(Trim(Str(tRs.Fields(tCtr).Value)), "dd/mm/yyyy hh:mm:ss")
tStr = tStr & Right(Space(19) & temp, 19)

Case Else
MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & " Please contact administrator", vbCritical, App.Title
End Select

Case Else

MsgBox "Invalid type", vbCritical, App.Title
End Select

Next tCtr

Print #1, tStr
tRs!UPDHOST = "Y"
tRs!UPDDT = icbalib.cpTRNDT
tRs!UPDID = icbalib.cpTLRID
tRs.Update

If Me.ProgressBar1.Value < Me.ProgressBar1.Max Then
Me.ProgressBar1.Value = Me.ProgressBar1.Value + tProgress
End If

tStr = ""
If tRs.EOF = False Then
tRs.MoveNext
End If

Next tRecordCount
'Wend

Print #1, Trim(Str(tHashTotal))
Close #1
Screen.MousePointer = 0
MsgBox Trim(Str(tRecCtr)) & " records exported", vbInformation, App.Title

If Err Then
MsgBox Error, 48, App.Title
StartExport = False
Exit Function
End If
StartExport = True
End Function

[mvrp350]

if you run this code in debug, what is the value for tRecCtr?

there are a few things worrying me:
cursortype: adOpenStatic, I use adOpenKeyset to make sure it returns a value for recordcount.
Next it's known that ADO might have some problems with recordcount,
I always use:

if tRs.recordcount>0 then
  tRs.movelast
  tRs.movefirst
  tRecCtr = tRs.recordcount
 
  for i = 1 to tRecCtr
 
    your code
 
    tRs.movenext
  next i
else
  msgbox "no records available"
end if

[dojek]

if you run this code in debug, what is the value for tRecCtr?

there are a few things worrying me:
cursortype: adOpenStatic, I use adOpenKeyset to make sure it returns a value for recordcount.
Next it's known that ADO might have some problems with recordcount,
I always use:

if tRs.recordcount>0 then
  tRs.movelast
  tRs.movefirst
  tRecCtr = tRs.recordcount
 
  for i = 1 to tRecCtr
 
    your code
 
    tRs.movenext
  next i
else
  msgbox "no records available"
end if

hi..

tRecCtr giving me the value of how many record i have inside my Trans table, and it is correct..

I change my cursortype to adOpenKeyset, but it still give the same result

[mvrp350]

is it always the same recordset that loops?
if so, try to figure out where it goes wrong, and run it in debug. That way you're able to see where something happens that may create the problem.

[Ecniv]

'---------CODE START---------------------
Public Function StartExport() As Boolean
On Error Resume Next

    Dim tRs As ADODB.Recordset
    Dim strSql as String
    Dim tFldCount as integer, tProgress As Integer
    Dim tRecCtr as long, tRecordCount as long, tCtr as long, 
    Dim tStr, jenny, strContents, Filename As String
    Dim tHashTotal As Integer
    Dim temp

'---- Validation checks
    If icbalib.CheckSecurity(Me) = False Then
        StartExport = False
        Exit Function
    End If
    Screen.MousePointer = 11

    Set tRs = New ADODB.Recordset
'    tRs.CursorLocation = adUseClient
'    tRs.CursorType = adOpenStatic
'    tRs.LockType = adLockPessimistic
'    tRs.Source = "SELECT * FROM TRANS WHERE UPDHOST<>'Y'"
'    tRs.ActiveConnection = mylib.ADO_Connection

    strSql = "SELECT * FROM TRANS WHERE UPDHOST<>'Y'"
    tRs.Open strSql, mylib.ADO_Connection, adOpenStatic, adLockPessimistic, adCmdText

'If tRs.RecordCount = 0 Then
    IF tRs.EOF then
        MsgBox "No Record found", vbCritical, App.Title
        Screen.MousePointer = 0
        tRs.Close
        StartExport = False
        Exit Function
    End If

    tStr = ""
    Filename = Trim(Me.txtFilename.Text)
    tRecCtr = tRs.RecordCount
    tHashTotal = 0
    Me.ProgressBar1.Value = 0
    Me.ProgressBar1.Max = tRecCtr
'---- ???? current record of 0/max records ??
    tProgress = tRecCtr / 100
    If tProgress < 1 Then tProgress = 1

    tRs.Movelast
    tRs.Movefirst
    tFldCount = tRs.Fields.Count
    tRecordCount = 0

'---- Debug print it to immediate window
'----    Msgbox if not available to debug.print it
    Debug.print tFldCount & " " & tRecCtr

    Open Filename For Output As #1

    tStr = ""

For tRecordCount = 0 To tRecCtr - 1

    For tCtr = 0 To tFldCount - 1
    
        'Characters
        Select Case tRs.Fields(tCtr).Type
            'VARCHAR, CHAR
            Case adVarChar, adChar
            'MsgBox "VARCHAR" & tRs.Fields(tCtr) DefinedSize & " " & tRs.Fields(tCtr).ActualSize, vbOKOnly
            
            
                tStr = tStr & Trim(tRs.Fields(tCtr).Value) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)
                
            'INTEGERS
            'cannot use DefineDSize and ActualSize for integer, boolean datatype
            'if someone alter TRANS table, this area of code must me updated as well.
            
            Case adInteger, adUnsignedInt
            
            'MsgBox "INTEGER" & tRs.Fields(tCtr).DefinedSize & " " & tRs.Fields(tCtr).ActualSize, vbOKOnly
               'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)
                Select Case tRs.Fields(tCtr).Name
                    
                    'SIZE EQUAL TO 6
                    Case "SEQNO", "ACNO", "ACNO2", "SEQCNT", "REFSEQNO"
                        tStr = tStr & Right(Space(6) & Trim(Str(tRs.Fields(tCtr).Value)), 6)
                    
                    
                    'SIZE EQUAL TO 2
                    Case "CHKDGT", "FLTDAY", "CHKDGT2"
                        tStr = tStr & Right(Space(2) & Trim(Str(tRs.Fields(tCtr).Value)), 2)
                    
                    'SIZE EQUAL TO 3
                    Case "TENOR"
                        tStr = tStr & Right(Space(3) & Trim(Str(tRs.Fields(tCtr).Value)), 3)
                                        
                    'SIZE EQUAL TO 4
                    Case "YEAR"
                        tStr = tStr & Right(Space(4) & Trim(Str(tRs.Fields(tCtr).Value)), 4)
                    
                    Case Else
                        MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & ".. Please contact administrator", vbCritical, App.Title
                 'tStr = tStr & Right(Space(tRs.Fields(tCtr).DefinedSize) & Trim(tRs.Fields(tCtr).Value), tRs.Fields(tCtr).Properties.Count)
                
                End Select
                
            'FLOAT
            Case adSingle, adDouble
                'If tRs.Fields(tCtr).Name = "TRNAMT" Then
                    'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(16 - Len(Trim(Str(tRs.Fields(tCtr).Value))), " ") '& Chr(9)
                    
                    'tHashTotal = tHashTotal + ComputeHash(tRs.Fields(tCtr).Value)
                'Else
                    'tStr = tStr & Trim(Str(tRs.Fields(tCtr).Value)) & String(tRs.Fields(tCtr).DefinedSize - tRs.Fields(tCtr).ActualSize, " ") '& Chr(9)
                    
                'End If
                
                Select Case tRs.Fields(tCtr).Name
                    
                    'SIZE EQUAL TO (16,2) 19
                    Case "TRNAMT"
                        tStr = tStr & Right(Space(19) & Trim(Str(tRs.Fields(tCtr).Value)), 19)
                    
                    'SIZE EQUAL TO (12,2) 15
                    Case "COMAMT", "CLRCOM"
                        tStr = tStr & Right(Space(15) & Trim(Str(tRs.Fields(tCtr).Value)), 15)
                        
                    'SIZE EQUAL TO (10,2) 13
                    Case "CHARGES"
                        tStr = tStr & Right(Space(13) & Trim(Str(tRs.Fields(tCtr).Value)), 13)
                    
                    Case Else
                        MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & " Please contact administrator", vbCritical, App.Title
                End Select
            
            'DATE
            Case adDBDate, adDBTimeStamp
                
                Select Case tRs.Fields(tCtr).Name
                    
                    'SIZE EQUAL TO DATE 10
                    Case "UPDDT", "TRNDT"
                    
                        temp = Format(Trim(Str(tRs.Fields(tCtr).Value)), "dd/mm/yyyy")
                       
                            'tStr = tStr & Right(Space(10) & "0" & Trim(Str(tRs.Fields(tCtr).Value)), 10)
                             tStr = tStr & Right(Space(10) & temp, 10)
                                
                    'SIZE EQUAL TO TIMESTAMP 19
                    Case "COMAMT", "TRNTIME"
                    
                        temp = Format(Trim(Str(tRs.Fields(tCtr).Value)), "dd/mm/yyyy hh:mm:ss")
                        tStr = tStr & Right(Space(19) & temp, 19)
                                       
                    Case Else
                        MsgBox "System didn't recognize this field!! " & tRs.Fields(tCtr).Name & " Please contact administrator", vbCritical, App.Title
                End Select
                
            Case Else
            
                MsgBox "Invalid type", vbCritical, App.Title
        End Select

        
    Next tCtr
    
    Print #1, tStr
    tRs!UPDHOST = "Y"
    tRs!UPDDT = icbalib.cpTRNDT
    tRs!UPDID = icbalib.cpTLRID
    tRs.Update

'---- ****** Shouldn't this be "current record"/"Max records" ?   
    If Me.ProgressBar1.Value < Me.ProgressBar1.Max Then
        Me.ProgressBar1.Value = Me.ProgressBar1.Value + tProgress
    End If
    
    tStr = ""
    If tRs.EOF = False Then
        tRs.MoveNext
    End If

Next tRecordCount
'Wend

Print #1, Trim(Str(tHashTotal))
Close #1
Screen.MousePointer = 0
MsgBox Trim(Str(tRecCtr)) & " records exported", vbInformation, App.Title

If Err Then
    MsgBox Error, 48, App.Title
    StartExport = False
    Exit Function
End If
StartExport = True
End Function

I prefer to check for EOF rather than Recordcount to see if there are records.

Static is fine - since you are not updating it would take a static look, and also allows you to use the recordcount.

How are you outputting the data, is it just meant to loop through the fields and output whats in them? or do specific things for certain fields?

Use the CODE] tags (the code button above the posting box) to surround your code.

I've commented in your code around the progress bits - I think your calc is wrong but thats for you to check.

Good luck making it work

[mvrp350]

Ecvic,

is checking for EOF not much slower than using for ... next?
Of course, using the for ... next-loop you'll need to write the recordcount to a variable first.
This will not be a problem when using small recordsets, but when using large ones it can make a lot of difference.

[Ecniv]

Correction

.EOF to see if there are records then the for next loop to get the data

You are right that the .eof check in a loop over loads of records is slower. Lots slower
But I use it just to make sure there are records, and not in the loop.

[mvrp350]

that makes more sense