Microsoft Office Tutorials and References
In Depth Information
Mail Merge: Creating a One-to-Many List
' * * * * *¶
Sub GetData(ByRef rs As ADODB.Recordset)¶
'Variable declaration¶
Dim conn As ADODB.Connection¶
Dim SQL As String¶
SQL = "Select " & GetFieldNames(FieldNames()) & _¶
" FROM [" & TableName & "] "¶
Set conn = New ADODB.Connection¶
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _¶
"Data Source=" & DatabasePath & ";" & _¶
"User Id=admin;Password="¶
rs.Open SQL, conn, adOpenStatic, adLockBatchOptimistic¶
'Use a disconnected recordset¶
rs.ActiveConnection = Nothing¶
conn.Close¶
Set conn = Nothing¶
End Sub¶
' * * * * *¶
Function GetFieldNames(lst() As Variant) As String¶
'Variable declaration¶
Dim i As Long, s As String¶
For i = 0 To UBound(lst())¶
s = s & "[" & lst(i) & "], "¶
Next¶
'Cut off the last comma-space¶
s = Left(s, Len(s) - 2)¶
GetFieldNames = s¶
End Function¶
' * * * * *¶
Function InsertList(bkm As Word.Bookmark, _¶
rs As ADODB.Recordset, idfield, id As Long) _¶
As String¶
'Variable declaration¶
Dim list As String¶
'Get only the records for the current pupil¶
FilterRecords rs, idfield, id¶
'Stop if there aren't any records¶
If rs.RecordCount <= 0 Then Exit Sub¶
'Put the data into delimited string¶
'that can be converted to a table¶
list = GetDataList(rs)¶
'Remove the record filter¶
rs.Filter = ""¶
CreateTable list, bkm, rs.Fields.Count - 1¶
End Function¶
' * * * * *¶
Sub FilterRecords(ByRef rs As ADODB.Recordset, _¶
ByVal idfield As String, ByVal id As Long)¶
'Variable declaration¶
Dim filterString As String¶
Wrd
Search JabSto ::




Custom Search