0

Perhaps someone can help me...

I'm trying to figure out how to transfer Access data to Word documents so that the data for each contact will transfer with a command.

Does anyone know how to do this?

2
Contributors
1
Reply
3
Views
8 Years
Discussion Span
Last Post by choudhuryshouvi
0

this is a sample code here for you. try it. just place a button and a textbox (with default names) on your form for testing.
just to make sure the following references are included in your project :-

1. Microsoft Word <version no.> object library
2. Microsoft Activex Data Objects <version no.> library

and you can download the sample access database used in this script from this link :-
http://www.homeandlearn.co.uk/NET/AddressBook.zip

hope this helps.
plz do post your feedbacks here.

Option Explicit

Dim WithEvents w As Word.Application
Dim UnloadForm As Boolean
''change the path and word file name here
Const docName = "c:\Doc1.doc"

Private Sub Command1_Click()
Call ConnectDb_WriteToWord
End Sub

Private Sub Form_Activate()
If UnloadForm Then Unload Me
End Sub

Private Sub Form_Load()
Text1.Text = ""

'Create the Word reference
On Error GoTo WordError
Set w = New Word.Application
w.Visible = True
Exit Sub

WordError:
    MsgBox "Error creating a Word reference: " & Err.Description, vbCritical, "Automation Error"
    UnloadForm = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo xx

'Quit Word and save changes
w.Quit wdSaveChanges

xx:
If Err.Number = 462 Then
    MsgBox Err.Description, vbCritical + vbApplicationModal, "Error"
    Exit Sub
End If
End Sub

Public Sub ConnectDb_WriteToWord()
Dim gcn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim str As String
Dim MyDoc As Document
Dim Opened As Boolean

''connecting with the database,
''fetching all contacts and
''writing them one by one in the textbox
gcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _
    "\AddressBook.mdb;Persist Security Info=False"
gcn.Open

rs.Open "select * from tblcontacts order by id", gcn, 1, 2

If rs.RecordCount > 0 Then
    rs.MoveFirst
    While Not rs.EOF()
        str = rs!ID & " - " & rs!firstname & " " & rs!surname & " " & rs!phone & " " & rs!Email
        Text1.SelText = str & vbCrLf
        rs.MoveNext
    Wend
End If

If rs.State = adStateOpen Then rs.Close
Set rs = Nothing

''linking with word reference previously created
''and writing strings from textbox to the word document
Opened = False
For Each MyDoc In w.Documents
    If MyDoc.FullName = docName Then Opened = True
Next

If Opened Then GoTo AlreadyOpen
On Error GoTo NewDoc

Opened = False
Set MyDoc = w.Documents.Open(docName, Revert:=False)
GoTo AlreadyOpen

NewDoc:
    Set MyDoc = w.Documents.Add
    MyDoc.SaveAs docName

AlreadyOpen:
    Clipboard.Clear
    Clipboard.SetText Text1.Text
    MyDoc.Words.Item(MyDoc.Words.Count).Paste
End Sub

regards
Shouvik

This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.