User Tools

Site Tools


vba:access:functions:printrs

[VBA][Access] printRs()

Gibt den Inhalt einer Tabelle/Abfrage/Recordsets im Textformat aus.

Version 3.1.0 (16.08.2017)

printRs() ist dazu gedacht, schnell die ersten X Zeilen einer Quelle (Tabelle, Abfrage, Recordset etc) als fornatierten Text auszugeben. Das ist praktisch für Debug-Zwecke, um Beispiele zu Funktionen zu dokumentieren oder um Tabelleninhalte/Resultate in ein Forum zu posten.

Wird zum Beispiel in der [VBA][Access] Klasse SQLScript verwendet

Download udf_printrs.bas (V-3.1.0)

Definition

Diese Funktion verwendet die Funktion [VBA] printList()

printRs(SELECT-Statement [,limit [,returnType[, cancel[, iFormats]]]])
printRs(recordset [,limit [,returnType[, cancel[, iFormats]]]])
printRs(tabellenname [,limit [,returnType[, cancel[, iFormats]]]])
printRs(TableDef [,limit [,returnType[, cancel[, iFormats]]]])
printRs(viewname [,limit [,returnType[, cancel[, iFormats]]]])
printRs(QueryDef [,limit [,returnType[, cancel[, iFormats]]]])
Public Function printrs( _
        ByVal iRs As Variant, _
        Optional ByVal iLimit As Integer = 10, _
        Optional ByVal iReturn As enuPrintListOutputMethode = prListConsole, _
        Optional ByRef oCancel As Boolean = False, _
        Optional ByRef iFormats As Variant = Null _
) As String

Parameter-Liste

  • iRs <Variant> (income)
    Mark text as key press Das offene DAO.Recordset. Es wird als ByVal übergeben und verändert somit das Original nicht. Es kann ein Recordet, ein SELECT-Statement, Tabellenname oder Abfragename sein
  • iLimit <Integer> (income)
    Maximal auszugebende Zeilen. Wenn die Zahl negativ ist, wird die Anzahl Zeilen vom Ende an ausgegeben
  • iReturn <enuPrintListOutputMethode> (optional income)
    Art der Rückgabe: Standart ist das Direktfenster. Alternativ kann man auch als Rückgabewert der Funktion oder in den Zwieschnepseicher des PCs schreiben. Die Auswahlen lassen sich auch kombinieren
  • oCancel <Boolean> (Otional outgoing)
    Rückgabeflag, ob der Print_Rs aus einem Grund abgebrochen wurde
  • iFormats Ein Array mit dFormaten um die Daten zu formatieren. Siehe auch format() von VBA

Beispiele

Direkt im Immadiate-Window

'Resultat einer Abfrage
printrs "vw_pivot_source"
| w1 | <> | 1 | 2 | 4 |
|----|----|---|---|---|
| 1  |    | 2 |   |   |
| 2  |    |   | 1 |   |
| 3  |    |   | 1 | 1 |
| 4  | 0  |   |   |   |
 
'Erste 5 Zeilen eines Recorsets
printrs currentdb.OpenRecordset("my_table"), 5
| ID | f_date              | f_string | f_double  |
|----|---------------------|----------|-----------|
| 1  | 14.03.2014 00:01:00 | abcd     | 1.15      |
| 2  | 23.06.2014 11:06:10 | bv       | 4         |
| 3  | 14.03.2014 00:03:00 | dd       | 165413.58 |
| 4  | 14.03.2014 00:17:00 | dsf      | 0.134     |
| 11 | 14.03.2014 00:10:00 |          | 0.5       |
 
'Rückgabe als String
?printrs("my_table", 5, prsReturn)
| ID | f_date              | f_string | f_double  |
|----|---------------------|----------|-----------|
| 1  | 14.03.2014 00:01:00 | abcd     | 1.15      |
| 2  | 23.06.2014 11:06:10 | bv       | 4         |
| 3  | 14.03.2014 00:03:00 | dd       | 165413.58 |
| 4  | 14.03.2014 00:17:00 | dsf      | 0.134     |
| 11 | 14.03.2014 00:10:00 |          | 0.5       |
 
'Direktes Auswerten eines SQL-Befehls
printrs "SELECT id, f_double FROM my_table ORDER BY f_double DESC", 5
| id | f_double   |
|----|------------|
| 3  | 165413.58  |
| 22 | 16546.1654 |
| 25 | 8694.1     |
| 12 | 156        |
| 18 | 151.584    |

Code

udf_printrs.bas
Attribute VB_Name = "udf_printRs"
'-------------------------------------------------------------------------------
'File         : udf_printRs.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/access/functions/printrs
'Environment  : VBA 2010 +
'Version      : 3.1.0
'Name         : printRs
'Author       : Stefan Erb (ERS)
'History      : 27.05.2014 - ERS - Creation
'               ....
'               18.07.2017 - ERS - Auf printlist() aufgabut
'               16.08.2017 - ERS - TempTableDef als Argument hinzugefügt -> http://wiki.yaslaw.info/doku.php/vba/access/classes/temptabledef
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' !!! WICHTIG !!!
' Diese Funktion verwendet die Funktion printList() http://wiki.yaslaw.info/doku.php/vba/functions/printlist
' Diese Funktion muss also auch im Projekt vorhanden sein
'-------------------------------------------------------------------------------
 
'/**
' * Diese Funktion dient zu Debug/Programmierzwecken. Sie macht in einem fertigen Program keinen Sinn mehr
' * Schreibt die ersten [iLimit] Zeilen in das Direktfenster
' *
' *     printRs(SELECT-Statement [,limit [,returnType [,cancel [,formate]]]])
' *     printRs(recordset [,limit [,returnType [,cancel [,formate]]]])
' *     printRs(tabellenname [,limit [,returnType] [,cancel [,formate]]]])
' *     printRs(TableDef [,limit [,returnType [,cancel [,formate]]]])
' *     printRs(viewname [,limit [,returnType [,cancel [,formate]]]])
' *     printRs(QueryDef [,limit [,returnType [,cancel [,formate]]]])
' *     printRs(TemTableDef [,limit [,returnType [,cancel [,formate]]]])
' *
' * @param  Recordset/String        Recordset, SELECT-String, Tabellenname oder ViewName
' * @param  Integer                 Limit der Zeilen. Default 10.
' *                                 Positiv:    Es werden die iLimit Anzahl Zeilen ausgegeben.
' *                                 0:          Es werden alle Zeilen ausgegeben
' *                                 Negativ:    Es werden die iLimit letzten Zeilen ausgegen
' * @param  enuPrintRsOutputMethode
' *                                 Art der Rückgabe: Standart ist das Direktfenster. Alternativ kann man auch als Rückgabewert der
' *                                 Funktion oder in den Zwieschnepseicher des PCs schreiben.
' *                                 Die Auswahlen lassen sich auch kombinieren: prConsole+prClipboard
' * @param  Boolean                 Rückgabeflag, ob der PrintRs aus einem Grund abgebrochen wurde
' * @param  Array<String>           Ein Array mit den Formaten um die Daten zu formatieren. Siehe auch format() von VBA
' * @retrun String                  Resultat oder Fehlermeldung
' */
Public Function printrs( _
        ByVal iRs As Variant, _
        Optional ByVal iLimit As Integer = 10, _
        Optional ByVal iReturn As enuPrintListOutputMethode = prListConsole, _
        Optional ByRef oCancel As Boolean = False, _
        Optional ByRef iFormats As Variant = Null _
) As String
    Dim qdf As QueryDef
    Dim rs As Object
    Dim db As DAO.Database: Set db = CurrentDb
    Dim limit As Integer
    Dim retVal As String
On Error GoTo Err_Handler
 
    Select Case TypeName(iRs)
        'Input ist ein String -> Als SQL/Tablename/Viewname handeln
        Case "String":                  Set rs = db.openRecordset(iRs, dbReadOnly)
        Case "Recordset", "Recordset2": Set rs = iRs.clone
        Case "QueryDef", "TableDef":    Set rs = iRs.openRecordset(dbOpenSnapshot)
        Case "TempTableDef":            Set rs = iRs.openRecordset(, dbOpenSnapshot)  'http://wiki.yaslaw.info/doku.php/vba/access/classes/temptabledef
        Case Else:                      Err.Raise 438       '438     Object doesn't support this property or method
    End Select
    'Max anz. Zeilen zum ausgeben
    If Not rs.BOF Then
        rs.MoveLast
        limit = IIf(iLimit = 0, rs.RecordCount, least(Abs(iLimit), rs.RecordCount) * Sgn(iLimit))
    End If
 
    Dim fldCnt      As Integer: fldCnt = rs.fields.count - 1    'Anzahl Felder
    Dim hdr()       As String:  ReDim hdr(fldCnt)               'Array mit dem Header
    Dim rowsUbound  As Long:    rowsUbound = IIf(rs.BOF, 0, Abs(limit) - 1)
    Dim data()      As Variant: ReDim data(rowsUbound)
    Dim row()       As Variant: ReDim row(fldCnt)
 
    'Spaltenüberschriften auslesen
    Dim i As Long: For i = 0 To rs.fields.count - 1
        hdr(i) = rs.fields(i).name
    Next i
 
    'Startpunkt setzen
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        Dim idx As Integer: For idx = 0 To rowsUbound
            If rs.EOF Then  'Bei übergabe von TabeDef kann es passieren, dass rs.RecordCount() zu viele Zeilen ausspuckt.
                ReDim Preserve data(idx - 1)
                Exit For
            End If
            rs.absolutePosition = idx
            ReDim row(fldCnt)
            For i = 0 To rs.fields.count - 1
                If getProperty(rs.fields(i), "IsComplex", False) Then
                    Dim rsV As Recordset2: Set rsV = rs.fields(i).value
                    Dim values() As String
                    Dim j As Long: j = -1
                    Do While Not rsV.EOF And Not rsV.BOF
                        ReDim Preserve values(inc(j)): values(j) = rsV!value.value
                        rsV.MoveNext
                    Loop
                    Set rsV = Nothing
                    row(i) = Join(values, ", ")
                Else
                    row(i) = rs.fields(i).value
                End If
            Next i
            data(idx) = row
        Next idx
    End If
    retVal = printList(data, hdr, iReturn, iFormats)
 
Exit_Handler:
    printrs = retVal
    Exit Function
Err_Handler:
    retVal = "Error " & Err.number & ": " & Err.DESCRIPTION
    oCancel = True
    Resume Exit_Handler
    Resume
End Function
 
'/**
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/
' *
' * Dieverse Objekte in Access besitzen Properties. Diese sind aber nicht immer initialisiert
' * Mit dieser Funktion verscuht man ein Property auszulesen. Wenn dies nicht funktioniert, wird ein Default-Wert zurückgegeben
' * @param  Object      Objekt welches das Property beinhalten sollte
' * @param  Name        Eigenschaftsname
' * @param  Variant     Default-Wert, falls die Eigenschaft nicht exisitiert
' * @return Variant
' */
Private Function getProperty(ByRef iObject As Object, ByVal iName As String, Optional ByRef iDefault As Variant = Null) As Variant
    On Error Resume Next
    If IsObject(iObject.properties(iName)) Then: Set getProperty = iObject.properties(iName): Else: getProperty = iObject.properties(iName)
    If Err.number <> 0 Then
        If IsObject(iDefault) Then: Set getProperty = iDefault: Else: getProperty = iDefault
    End If
End Function
 
vba/access/functions/printrs.txt · Last modified: 18.08.2017 12:18:45 by yaslaw