This example assumes you are writing a letter and you want to insert an address held in a database. Although you could use mail merge to perform this task, it can be convenient at times to do this with a macro.
Each section of the macro will be broken down and explained. The full source listing can be found here .
1. Start the macro, declare and initialize some variables
Sub InsertDBAddress
Dim app, mydb, mytb, srchtxt, dbpath, tbname, srchfld, qrytxt
dbpath = "c:\my documents\mydata.adb"
tbname = "mytable"
srchfld = "Lastname"
All the variables used in the macro are declared locally – this is good practice as it safes any possible confusion over whether a variable is local or global.
Insert your own details for database name (including path), the table name and the field you want to search on. In this case, we're allowing records to be found by lastname – not always practical with large tables.
2. Open the database
Set app = CreateObject("AbilityDatabase.Application")
app.Databases.Open dbpath, False
Set mydb = app.ActiveDatabase
Creates the database application object, opens a database and sets a reference, mydb, to it.
3. Get the input from the user
srchtxt = InputBox("Enter " & srchfld & ":", "Ability Message")
If Len(srchtxt) = 0 Then
Exit Sub
End If
This prompts the user to enter some data to search for. As a refinement, if the user enters nothing (or selects the "Cancel" button) then the macro will terminate with the "Exit Sub" statement.
4. Open a query
qrytxt = "SELECT * FROM " & tbname & " WHERE " & srchfld & "='" & srchtxt & "'"
Set mytb = mydb.Admin.OpenRecordset(qrytxt)
The first line creates a query, based on the whatever the user entered. For example if the table was called "contacts" and your were searching on a company name field for "Ability Software" the variable qrytxt would contain:
SELECT * FROM contacts WHERE company ='Ability Software'
Which is slightly more readable. Note the use of single apostrophes surrounding Ability Software – these are in the code but only just visible since they are next to double quotes. Without these single apostrophes, the macro would fail!
The second line uses a property of the database object called Admin – for users familiar with DAO, Admin is exactly equivalent to a DBEngine.Database object. The end result is that we've opened a query that contains only the record(s) matching the search text.
5. See if there are any records found
If mytb.BOF Then
MsgBox "No matching records"
Exit Sub
End If
BOF stands for beginning of file (EOF being end of file). When the query was opened, if it contains no records, BOF will be true, and if so, a message is displayed and the macro terminates with "Exit Sub"
If there are records BOF will be false, and we will be positioned on record 1.
6. One or more records?
mytb.MoveNext
If mytb.EOF Then
mytb.MoveFirst
Selection.InsertAfter BuildAddBlock(mytb.Fields)
Selection.Collapse(1)
End If
Assuming we're on record 1, a call to move to the next record will cause EOF to be true only if there is only one record. That is, the user entered some search text and there is only one matching record, and we've found it. No ambiguity, so we can paste the data into the Write.
Inside the If Then statement, the first thing to do is head back to record 1. Next, the Selection.InsertAfter command pastes the text into the current Write document, where the text is generated by the BuildAddBlock function (described below). Selection.Collapse(1) turns of selected text.
7. More than one record, so browse
Logic tells us that if there is at least one record (part 5 above) and not exactly 1 record (part 6. above) then there must be two or more matching records. This could easily happen searching for the lastname of Smith for example. In this case, we can browse through the records until the user picks one.
mytb.MoveFirst
Do
ret = MsgBox("More than one record - Select this record " & _
"With the Yes button or choose No For Next " & _
"record" & vbCr & vbCr & BuildAddBlock(mytb.Fields), _
vbYesNoCancel, _
"Ability Message")
If ret = vbCancel Then
Exit Sub
ElseIf ret = vbYes Then
Exit Do
End If
mytb.MoveNext
If mytb.EOF Then
ret = MsgBox("End of records!" & vbCr & vbCr & _
"Review records again?", vbYesNo, _
"Ability Message")
If ret = vbNo Then
Exit Sub
End If
mytb.MoveFirst
End If
Loop
Selection.InsertAfter BuildAddBlock(mytb.Fields)
Selection.Collapse(1)
End Sub
The basic idea repeat for ever (Do....Loop) until the user chooses to select a record, browse to the next record or start the browse over again if he reaches the end. The command Exit Do jumps out of the loop at the users bidding.
The macro is finished of by inserting the text as described in part 6. above.
A quick note on the use of MsgBox. MsgBox is a built in function that takes one or more parameters. In the examples above, MsgBox is called with three parameters:
Prompt
Buttons
Title
Prompt is the text displayed inside the dialog. Title is the text displayed on the title bar of the dialog. Buttons controls what buttons to display on the dialog. vbYesNoCancel builds the dialog with three buttons: Yes, No and Cancel. Which button the user selects can be tested for by assigning the return value of MsgBox to a variable (called ret above). So ret = vbYes is true if the user selected the Yes button and so on.
8. BuildAddBlock and AddLine functions
There are several calls to this function from the main code above. The idea is to take named fields and construct a single string that is suitable for an address block (i.e. no gaps).
Function BuildAddBlock(Flds)
Dim s
s = Flds("CustTitle") & " " & Flds("FirstName") & " " & Flds("Lastname") & vbCr
s = s & AddLine(Flds("Company"))
s = s & AddLine(Flds("Add1"))
s = s & AddLine(Flds("Add2"))
s = s & AddLine(Flds("Add3"))
s = s & AddLine(Flds("Add4"))
s = s & AddLine(Flds("Postcode"))
BuildAddBlock = s
End Function
The function is declared with a single parameter. In the calling code the following line is used to invoke the function:
BuildAddBlock(mytb.Fields)
The result of this is that mytb.Fields (i.e. the fields for the current record) is mapped into a variable called Flds in the function definition.
A variable s is built-up by calling the function AddLine which checks to make sure the line is not blank.
Function AddLine(x)
AddLine = ""
If Len(x) > 0 Then
AddLine = x & vbCr
End If
End Function