Hier habe ich mal ein CodeBeispiel, das ich mal programmiert habe.
Da fehlt nur noch das Erzeugen eines Notes Docs und die Übertragung der Werte: Ich lasse die mir hier nur anzeigen. War mal ne Demo aus einem Workshop für Programmierer, den ich mal geleitet habe
Sub Click(Source As Button)
On Error Resume Next
Dim Accessdb As Variant
Dim rst As Variant
Dim ColNum As Integer
Dim RecValue As Variant
Dim FieldNames As New ArraySets '// Class Constructor for ArraySets
tbl$ = "Test"
Set dbE = CreateObject ( "DAO.DBEngine.35" )
Set ws = dbE.CreateWorkspace ( "" , "admin" , "" , 2 )
Set AccessDB = ws.OpenDatabase ( "d:\test.mdb" )
Set rst = AccessDB.OpenRecordset( tbl$ )
iRecCount = rst.RecordCount '// Get number of records in the table
'=======================================================================
'// As long as I do not know a better method to determine the colNames of the AccessTable
'// I do it this way
'// Using "ArraySets Class" from LibGenric
FieldNames.Init '// Initialize ArraySetsObject
NoMoreCols = False
Do Until NoMoreCols = True '// As far as there are Cols in the Table
FieldName$ = rst.Fields ( ColCount% ).Name '// Get ColName
If FieldName$ = "" Then '// if ColName is Nothing
NoMoreCols = True '// do some stuff to leave this routine
Else
FieldNames.AddElement ( FieldName$ )
FieldName$ = "" '// else fill the ArraySetsObject with the colNames
ColCount% = ColCount% + 1 '// increase the counter
End If
Loop
ColCount% = FieldNames.TotalElements '// Get Number of Cols
'=======================================================================
rst.MoveFirst
Do Until rst.EOF ' as long as there are records in the table
'// get a record; we do not need rst.MoveNext because the pointer
'// is automatically positoned to the next record
RecValue = rst.GetRows()
For i% = 0 To ( ColCount% - 1 )
tmp$ = tmp$ + ", " + RecValue ( 0 , i% )
Next
Msgbox tmp$
tmp$ = ""
Loop
rst.Close
Set rst = Nothing
Set Accessdb = Nothing
End Sub
'==========================================================================================
' C L A S S "ArraySets"
'==========================================================================================
Class ArraySets
Public Value() As String
Public TotalElements As Integer
Sub Init
TotalElements = 0
Redim Value(1 To 1) As String
End Sub
Sub AddElement(NewValue As String)
TotalElements = TotalElements + 1
Redim Preserve Value(1 To TotalElements) As String
Value(TotalElements) = NewValue
End Sub
Function Search(SearchFor As String) As Integer
Dim CurrentLabelEntry As Integer
CurrentLabelEntry = 1
Forall c In Value
If Ucase(c) = Ucase(SearchFor) Then Exit Forall
CurrentLabelEntry = CurrentLabelEntry + 1
End Forall
Search = CurrentLabelEntry
End Function
End Class
