Option Explicit
Sub Main()
frmContacts.Show
End Sub
Public Sub FillBookmark(sText As String, sBookmark As String)
Dim oRange As Word.Range
With Application.ActiveDocument
Set oRange = .Bookmarks(sBookmark).Range
oRange.Text = sText
.Bookmarks.Add Name:=sBookmark, Range:=oRange
Set oRange = Nothing
End With
End Sub
Option Explicit
Private Sub UserForm_Initialize()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = OpenDatabase(ActiveDocument.Path & "\Contacts.mdb")
Set rst = dbs.OpenRecordset("Select Name FROM Contacts;")
Do While Not rst.EOF
Me.cboContacts.AddItem rst("Name")
rst.MoveNext
Loop
Set rst = Nothing
Set dbs = Nothing
End Sub
Private Sub cmdInsert_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
If Me.cboContacts.ListIndex = -1 Then
Beep
MsgBox "Make a choice first", 64, "Choose from list"
Exit Sub
Else
Me.Hide
Set dbs = OpenDatabase(ActiveDocument.Path & "\Contacts.mdb")
Set rst = dbs.OpenRecordset("Select * FROM Contacts WHERE Name = '" & _
Me.cboContacts.Text & "';")
Call FillBookmark("" & rst.Fields("Company"), "bmCompany")
Call FillBookmark("" & rst.Fields("Name"), "bmName")
Call FillBookmark("" & rst.Fields("Address"), "bmAddress")
Call FillBookmark("" & rst.Fields("Postal") & Chr$(32) & rst.Fields("City"), "bmCity")
Call FillBookmark("" & rst.Fields("Phone"), "bmPhone")
Call FillBookmark("" & rst.Fields("Mobile"), "bmMobile")
Call FillBookmark("" & rst.Fields("Fax"), "bmFax")
Call FillBookmark("" & rst.Fields("Website"), "bmwww")
Call FillBookmark("" & rst.Fields("Email"), "bmEmail")
Call FillBookmark("" & rst.Fields("Language"), "bmLanguage")
Call FillBookmark("" & rst.Fields("Memo"), "bmMemo")
ActiveDocument.Fields.Update
End If
Unload Me
Set rst = Nothing
Set dbs = Nothing
End Sub
|