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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

transfer query results to a current word document 1

Status
Not open for further replies.

cneill

Instructor
Mar 18, 2003
210
GB
please help, I am trying to transfer the query result to the bookmarks in a word document I have already created
it stops at
Set rst = db.OpenRecordset("QryHousingBenefit")
telling me there is two few parameters.expected 1
I have checked the query and it is producing the right results
does anyone know where I am going wrong? or point me in the right direction?

Private Sub HousingBenefit_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim doc As Word.Document
Dim MyWord As Word.Application
Dim HAddress As String
Dim HAddress1 As String
Dim TName As String
Dim MRent As String
Dim MRent1 As String
Dim Deposit As String

Set db = CurrentDb
Set rst = db.OpenRecordset("QryHousingBenefit")
rst.MoveFirst
Set doc = MyWord.Documents.Open("C:\Documents and Settings\Compaq_Owner\My Documents\Dee\Houses\SET UP DOCS\Housing Benefit Authorisation Form May 2011.docx")

HAddress = rst!HouseAddress
HAddress1 = rst!HouseAddress1
TName = rst!TenantName
MRent = rst!MonthlyRent
MRent1 = rst!MonthlyRent1
Deposit = rst!Deposit

doc.Bookmarks("HouseAddress").Range.Text = HAddress
doc.Bookmarks("HouseAddress1").Range.Text = HAddress1
doc.Bookmarks("TenantName").Range.Text = TName
doc.Bookmarks("MonthlyRent").Range.Text = MRent
doc.Bookmarks("MonthlyRent1").Range.Text = MRent1
doc.Bookmarks("Deposit").Range.Text = Deposit

End Sub
 
tweak this code and try:

Dim objWord As Object
'
Set objWord = CreateObject("Word.Application")
'
objWord.Documents.Add "full path of word doc u want to use"
'
objWord.Visible = False
'
With objWord.ActiveDocument.Bookmarks
'
.Item("bookmarkname").Range.Text = rst!fieldname
.Item("bookmarkname").Range.Text = rst!fieldname
.Item("bookmarkname").Range.Text = rst!fieldname
.Item("bookmarkname").Range.Text = rst!fieldname
'
end with
'
objWord.ActiveDocument.SaveAs FileName:="full path you want to save to"
'
objWord.Quit SaveChanges:=wdDoNotSaveChanges
'
Set objWord = Nothing
 
hey

i just notice your question is about your query and not how to insert into word
sorry

don't use "set db = currentdb"

use : "set rst=currentdb.openrecordset("name of your query",dbopensnapshot)"
 
That error occurs when it does not like the query syntax and you try to open the query in code. So you need to post the query. If the query actually has parameters there are additional steps that need to happen when opening it in code, but you can get that error if there is any issue with the syntax nothing to do with parameters.

example "Select field1 fromTableOne"

 


Hi,

Use the appropriate tool for the job. I'd embed an Excel MS Query to the MS Access table/query. No code required.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hi Everyone,

Thanks for all your thoughts, I will have a look at this tonight and get back to you
SkipVought
How do you do what you are suggesting as I have not done this before?

Thanks

CNEILL
 
I'd replace this:
Set rst = db.OpenRecordset("QryHousingBenefit")
with this:
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set qdf = db.QueryDefs("QryHousingBenefit")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 



What verion of Office?

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
there is two few parameters.expected 1
Did you try my suggestion ?
 
Hi PHV,

I am at work at the present time, so don't have access to my home PC, am going to look at your idea tonight, so will report back tomorrow.

Thanks
CNEILL
 
Hi PHV,

I think I modified the code correctly,

Set db = CurrentDb
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set qdf = db.QueryDefs("QryHousingBenefit")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset
rst.MoveFirst
Set doc = MyWord.Documents.Open("C:\Documents and Settings\Compaq_Owner\My Documents\Dee\Houses\SET UP DOCS\Housing Benefit Authorisation Form May 2011.docx")

but when it gets to Set Doc I get
object variable or with block variable not set
any thoughts?

thanks
cneill
 
This code is from the WORD document that has been populated from access
Code:
Option Explicit
 
 
Private Type MAPIMessage 'Mail
    Reserved       As Long
    Subject        As String
    NoteText       As String
    MessageType    As String
    DateReceived   As String
    ConversationID As String
    Flags          As Long
    RecipCount     As Long
    FileCount      As Long
End Type
 
Private Type MapiRecip 'Recipient
    Reserved   As Long
    RecipClass As Long
    Name       As String
    Address    As String
    EIDSize    As Long
    EntryID    As String
End Type
 
Private Type MapiFile 'File
    Reserved As Long
    Flags    As Long
    Position As Long
    PathName As String
    FileName As String
    FileType As String
End Type
 
 ' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0
Private Const MAPI_USER_ABORT = 1
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Private Const MAPI_E_FAILURE = 2
Private Const MAPI_E_LOGIN_FAILURE = 3
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Private Const MAPI_E_DISK_FULL = 4
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5
Private Const MAPI_E_BLK_TOO_SMALL = 6
Private Const MAPI_E_TOO_MANY_SESSIONS = 8
Private Const MAPI_E_TOO_MANY_FILES = 9
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14
Private Const MAPI_E_BAD_RECIPTYPE = 15
Private Const MAPI_E_NO_MESSAGES = 16
Private Const MAPI_E_INVALID_MESSAGE = 17
Private Const MAPI_E_TEXT_TOO_LARGE = 18
Private Const MAPI_E_INVALID_SESSION = 19
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Private Const MAPI_E_MESSAGE_IN_USE = 22
Private Const MAPI_E_NETWORK_FAILURE = 23
Private Const MAPI_E_INVALID_EDITFIELDS = 24
Private Const MAPI_E_INVALID_RECIPS = 25
Private Const MAPI_E_NOT_SUPPORTED = 26
 
Private Const MAPI_ORIG = 0 'Recipient-Flags
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3
 
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_FORCE_DOWNLOAD = &H1000
 
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2
 
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0
 
Private Const MAPI_OLE = &H1
Private Const MAPI_OLE_STATIC = &H2
 
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2
Private Const MAPI_SENT = &H4
 
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal User As String, ByVal Password As String, ByVal Flags As Long, _
ByVal Reserved As Long, Session As Long) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, _
ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" _
(ByVal Session As Long, ByVal UIParam As Long, Message As MAPIMessage, _
Recipient() As MapiRecip, File() As MapiFile, ByVal Flags As Long, _
ByVal Reserved As Long) As Long
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal DelimStr As String, ByVal FilePaths As String, ByVal FileNames As String, _
ByVal Reserved As Long) As Long
 
 
 
 
Function SendIt(sRecip As String, sTitle As String, sText As String, sFile As String) As Boolean
    Dim strTemp      As String
    Dim strError      As String
    Dim lngIndex      As Long
    Dim iFileCount As Integer
     
    Dim mRecip(0) As MapiRecip, mFile() As MapiFile, mMail As MAPIMessage
    Dim lSess As Long, lRet As Long
     
    On Error GoTo ErrorHandler
    SendIt = False
     
     'Add 2 trailing spaces to the text, this will be the position where the attachment goes to
    sText = sText & "  "
     
     'Recipient
    With mRecip(0)
        .Name = sRecip
        .RecipClass = MAPI_TO
    End With
     
     'File to send?
    If sFile <> "" Then
        ReDim mFile(0)
        With mFile(0)
            .FileName = sFile
            .PathName = sFile
            .Position = Len(sText) - 1
            .FileType = ""
            .Reserved = 0
        End With
        iFileCount = 1
    End If
     
     'Create Mail
    With mMail
        .Subject = sTitle
        .NoteText = sText
        .Flags = 0
        .FileCount = iFileCount
        .RecipCount = 1
        .Reserved = 0
        .DateReceived = ""
        .MessageType = ""
    End With
     
     'Post it
     'Logon: User = "" and Password = ""
    lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess)
    If lRet <> SUCCESS_SUCCESS Then
        strError = "Error logging into messaging software. (" & CStr(lRet) & ")"
        GoTo ErrorHandler
    End If
     
     'Send the mail to the given recipients with the attached file without showing a dialog
    lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0)
    If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then
        If lRet = 14 Then
            strError = "Recipient not found"
        Else
            strError = "Error sending: " & CStr(lRet)
        End If
        GoTo ErrorHandler
    End If
     
    lRet = MAPILogoff(lSess, 0, 0, 0)
     
    SendIt = True
    Exit Function
     
ErrorHandler:
    If strError = "" Then strError = Err.Description
    Call MsgBox(strError, vbExclamation, "MAPI-Error")
End Function

 
 

 
Sub eMailActiveDocument()
 
    Dim Doc As Document
     
    Application.ScreenUpdating = False
    Set Doc = ActiveDocument
    Doc.Save
     
    SendIt "me@mysite.com", "A new Access Card for person below", "Hi, read this:", Doc.FullName
     
    Application.ScreenUpdating = True
    Set Doc = Nothing
End Sub

The problem it will not send Like it to on close of document with somthing like document_close()

I can run the macro from the tool bar and it will send the document. But not any other time. Any idea I had it working with outlook. now using MAPI so can use many email programs

Never give up never give in.

There are no short cuts to anything worth doing :)
 
cneil, the message is explicit:
where is MyWord defined and instantiated ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hi PHV,

Yes I see what you mean, added some more code, but it is now stopping further down the code, so I thought if I give you all the code I have so far, you might be able to identify where I have gone wrong.
I am getting the same error
object variable or with block variable not set
at doc.Bookmarks("HouseAddress").Range.Text = HAddress

Private Sub HousingBenefit_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim doc As Word.Document
Dim MyWord As Word.Application
Dim HAddress As String
Dim HAddress1 As String
Dim TName As String
Dim MRent As String
Dim MRent1 As String
Dim Deposit As String
Dim WordObj As Word.Application
Dim WordDoc As Word.Document
Dim WordRange As Word.Range
Set WordObj = CreateObject("Word.Application")
Set WordDoc = WordObj.Documents.Open _
("C:\Documents and Settings\Compaq_Owner\My Documents\Dee\Houses\SET UP DOCS\Housing Benefit Authorisation Form May 2011.docx")
WordObj.Visible = True
Set db = CurrentDb
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set qdf = db.QueryDefs("QryHousingBenefit")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset
rst.MoveFirst
Set WordDoc = WordObj.Documents.Open _
("C:\Documents and Settings\Compaq_Owner\My Documents\Dee\Houses\SET UP DOCS\Housing Benefit Authorisation Form May 2011.docx")
WordObj.Visible = True
HAddress = rst!HouseAddress
HAddress1 = rst!HouseAddress1
TName = rst!TenantName
MRent = rst!MonthlyRent
MRent1 = rst!MonthlyRent1
Deposit = rst!Deposit

doc.Bookmarks("HouseAddress").Range.Text = HAddress
doc.Bookmarks("HouseAddress1").Range.Text = HAddress1
doc.Bookmarks("TenantName").Range.Text = TName
doc.Bookmarks("MonthlyRent").Range.Text = MRent
doc.Bookmarks("MonthlyRent1").Range.Text = MRent1
doc.Bookmarks("Deposit").Range.Text = Deposit
End Sub

thanks cneill
 
Hi PHV,
Sorry just noticed that I have the file path to the document twice, have changed this but still the same error

Thanks CNEILL
 
sorry cneill this was suposed to be in a different tread. Yes Bookmarks work well

Never give up never give in.

There are no short cuts to anything worth doing :)
 
Replace all doc.Bookmarks with WordDoc.Bookmarks

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Hi PHV,

Fantastic, now working a treat

Many Thanks

CNEILL
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top