The notepad reporter

The notepad reporter
Harry Caporuscio

We recently ran a tip about writing to Excel from VB. But here's a more general tip, from reader Harry Caporuscio that lets you write to, well, almost anything.

I recently needed to write an app that could take the results from a SQL query and output it in a report. Trick was that the client machine did not have any Office components installed. So I created the Notepad reporter.

This was written to a Sybase database using ADO through an ODBC driver. You may be able to use a different type cursor using a native driver. I found that using a static cursor treated everything, even integers, as strings and stripped the trailing zeros.

 
Option Explicit
Dim gCn As ADODB.Connection
Dim rsTemp As Recordset

Public Function TableToNotePad(sSource _
    As String, sFile As String) As Boolean
        
    Dim sHeader As String
    Dim sRow As String
    Dim i As Integer
    Set gCn = New ADODB.Connection
    MousePointer = vbHourglass
    With gCn
        .ConnectionTimeout = 300
        .ConnectionString = "Driver={Sybase System
 11};SRVR=DBSVR;DB=database;UID=user;PWD=password"
        .Open
    End With
    Set rsTemp = New ADODB.Recordset
    With rsTemp
                .ActiveConnection = gCn
                .CursorType = adOpenDynamic
                .LockType = adLockReadOnly
                .CursorLocation = adUseServer
                .Open (sSource)

        '  Make sure you have records to write
        If rsTemp.EOF And rsTemp.BOF Then
            TableToNotePad = False
            .Close
            Set rsTemp = Nothing
            If MsgBox("There were no records returned.  Click OK to try again,
 Cancel to quit.", vbOKCancel, "No Records") = vbOK Then
                Close #1 ' Target file is complete
                Set rsTemp = Nothing
                gCn.Close
                Set gCn = Nothing
                MousePointer = vbNormal
                Exit Function
            Else
                End
            End If
        End If

        '  Create new report file
        Open sFile For Output As #1
        '  Create a header row using the field names and column widths
        For i = 0 To .Fields.Count - 1
            If i = 0 Then
                sHeader = .Fields(i).Name
            Else
                sHeader = sHeader & Space(.Fields(i).DefinedSize - Len(.Fields
(i).Name)) & .Fields(i).Name
            End If
        Next i
        Print #1, sHeader

        ' Loop through the table and write data rows
        .MoveFirst
        Do Until .EOF
        
'****Put a case construct here to trap for blobs and to only use the replace
'on text fields.
        
            For i = 0 To .Fields.Count - 1
                If i = 0 Then
                    sRow = .Fields(i).Value & Space(.Fields(i).DefinedSize - 
Len(.Fields(i).Value))
                Else
                    If .Fields(i).Type = adLongVarChar Then
                        sRow = sRow & Space(.Fields(i).DefinedSize - Len
(.Fields(i).Value))
                    End If
                    If .Fields(i).Type = adNumeric Or .Fields(i).Type = 
adUnsignedTinyInt Then
                        sRow = sRow & .Fields(i).Value & Space(.Fields
(i).DefinedSize - Len(.Fields(i).Value))
                    Else
                        If Len(.Fields(i).Value) <> 0 Then
                            sRow = sRow & .Fields(i).Value & Space(.Fields
(i).DefinedSize - Len(.Fields(i).Value))
                        Else
                            sRow = sRow & Space(.Fields(i).DefinedSize - Len
(.Fields(i).Value))
                        End If
                    End If
                End If
            Next i
            Print #1, sRow
            .MoveNext
        Loop
        .Close
    End With
    Close #1 ' Target file is complete
    Set rsTemp = Nothing
    gCn.Close
    Set gCn = Nothing
    MousePointer = vbNormal
    TableToNotePad = True
TableToNotePad_Exit:
    Exit Function
TableToNotePad_Err:
    Resume Next
End Function

Private Sub cmdEnd_Click()
Set rsTemp = Nothing
Set gCn = Nothing
MousePointer = vbNormal
End
End Sub

Private Sub cmdReport_Click()
Dim strSQL As String
Dim Note As Integer
strSQL = "select lastname, firstname from person where lastname like 'cap%'"
If Len(strSQL) > 1 Then
    If TableToNotePad(strSQL, "c:Report.txt") = True Then
        Note = Shell("notepad c:Report.txt", vbMaximizedFocus)
    End If
Else
    MsgBox "There is no report to create"
    Exit Sub
End If
End Sub

Thanks, harry. To show our appreciation for your interest in SearchVB, we'll send you a SearchVB denim shirt.

Harry Caporuscio is a senior programmer/analyst with Wellpoint Health Systems in Newbury Park, CA.