Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy to excel and merge with word from access

Status
Not open for further replies.

puppy39

Programmer
Mar 13, 2009
41
US
I am trying to create a button on a form that would simple copy the data of a query to excel and automtically saves the file to the c drive as qrylabels then execute the following code using the qrylabel excel file as the datasource for a mailmerge in word.

Private Sub bttnWord_Click()
Dim LWordDoc As String
Dim oApp As Object

'Path to the word document
LWordDoc = "C:\MailMergeLabels.doc"

If Dir(LWordDoc) = "" Then
MsgBox "Document not found."

Else
'Create an instance of MS Word
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True

'Open the Document
oApp.Documents.Open filename:=LWordDoc
oApp.OpenDataSource Name:="C:\qrylabels.xls"
oApp.ActiveDocument.MailMerge.Execute 0
oApp.ActiveDocument.Fields.Update
End If

End Sub

Every single time the user clicks on the button it should write over the existing one and remerge. I am using ADP with SQL. From word the user then decides to view the file, make some minor changes if needed and then print. Problem is I know I am missing a few lines of code here and have no clue what those are. Please help!!
 
The code below will automate Excel but you may want to consider bypassing Excel and use the database as your merge source.

Private Sub cmdReportExcel_Click()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim strFileName As String
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim iCols As Integer

'Create and open Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
Set xlWS = xlWB.Worksheets.Item("Sheet1")

Set rs = New ADODB.Recordset

Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandText = "QryNameHere"
cmd.CommandType = adCmdTable
rs.Open cmd
'This code puts the field names as the first row of data
For iCols = 0 To rs.Fields.Count - 1
xlWS.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
'Copy data starting with second row
xlWS.Range("A2").CopyFromRecordset rs

strFileName = "C:\qrylabels.xls"
xlWB.SaveAs strFileName
xlWB.Close , False
xlapp.Quit
Set xlWB = Nothing
Set xlApp = Nothing

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top