Stuart Sanders
stuart at pacific.net.hk
Thu Aug 21 08:31:13 CDT 2003
Ok bit of extra coding required, but here goes on one possible solution. (note I'm hand coding this in outlook, so be forgiving of
errors)
Function BuyerBadges()
Dim objWord As Word.Document
dim lngCount as long
lngCount = 0
' clear temp tables
strSQL = "Delete * from tblTempBuyerBadges2"
Docmd.runsql strSQL
strSQL = "Delete * from tblTempBuyerBadges3"
Docmd.runsql strSQL
'copy badge data to table 2
strSQL = "INSERT INTO tblTempBuyerBadges2 " & _
"SELECT tblTempBuyerBadges.* FROM tblTempBuyerBadges"
Docmd.runsql strSQL
'now iterate through table copying 600 at a time
do
'increment count
lngCount = lngCount + 1
'copy 600. appropriate where clause needed (see later)
strSQL = "INSERT INTO tblTempBuyerBadges3 " & _
"SELECT TOP 600 tblTempBuyerBadges2.* FROM tblTempBuyerBadges2"
Docmd.runsql strSQL
'create word doc with number of iteration in name
Set objWord = GetObject("F:\Document Masters\Buyer
Documents\BuyerBadges" & cstr(lngCount) & ".doc", "Word.Document")
' Make Word visible.
objWord.Application.Visible = True
' Set the mail merge data source as the JemsXP database.
objWord.MailMerge.OpenDataSource _
Name:="C:\Program Files\JemsXP\JemsXP.mdb", _
LinkToSource:=True, _
Connection:="TABLE tblTempBuyerBadges3", _
SQLStatement:="Select * from [tblTempBuyerBadges3] WHERE
(((tblTempBuyerBadges3.PrintFlag)= True))"
' Execute the mail merge.
objWord.MailMerge.Execute
'clean up code required here for word doc?
'need to remove records copied from tblTempBuyerBadges2. If the query
'will produce the same records each time (ie SELECT TOP 600) then
'delete query will suffice
strSQL = "DELETE * FROM tblTempBuyerBadges2 " & _
"WHERE [PK] In (SELECT TOP 600 [PK] FROM tblTempBuyerBadges3)"
Docmd.runsql strSQL
'also empty tblTempBuyerBadges3
strSQL = "Delete * from tblTempBuyerBadges3"
Docmd.runsql strSQL
Loop until RecordCheck("tblTempBuyerBadges2") = 0
End Function
Also need RecordCheck()
Function RecordCheck(strTableName as string) as long
dim rst as recordset
set rst = currentdb.openrecordset(strtablename, dbopenforwardonly)
recordcheck = rst.recordcount 'or whatever is the correct command for this
set rst = nothing
End function
> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com
> [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
> William Hindman
> Sent: Thursday, 21 August, 2003 10:56 AM
> To: Access Developers discussion and problem solving
> Subject: [AccessD] Select Range of Records ...Word from Access
>
>
> ...ok ...just don't ask how I get into these things ...and if
> this seems
> like a JC post, I really don't want to hear about it :(
>
> ...I have a pretty good client who has been printing badges for his
> tradeshows from a db I wrote for him ...merging to a Word document and
> printing on preformatted badges ...piece of cake.
>
> ...now he's decided that with his nifty new $18K heavy duty
> high speed color
> printer (NEVER buy a Minolta printer) that he can do the
> entire print job
> in-house ...including some heavy duty badge graphics ...so
> after untold
> hours (paid hourly) of formatting this wonderful new badge
> with umpteen
> changes upon umpteen changes we finally get to the dirty deed
> of printing
> badges for a forthcoming show ...test pass of a few hundred
> records runs
> fine ...he's impressed ...I'm relieved ...go on to next client :)
>
> ...his badge person runs the badge print process on the
> entire list and
> everything on the db side works fine ...in this case there
> are 4200+ badges
> to print ...and therein lies my tale of woe :(
>
> ...the new improved graphics in-house badge has four records
> per 11x17 sheet
> ...and those 4200 records when merged into a new word
> document produce a
> file more than 75mb in size ...Word chokes at 32mb ...boy does it ever
> choke! :(((((
>
> ...complete redo of the badge template doc cuts the doc size
> by a quarter
> ...can't seem to squeeze any more out of it :(
>
> ...so I have to somehow cut the size of the file
> significantly ...I want it
> under 20mb so that editing is halfway reasonable.
>
> ...I thought about splitting the file into four parts at the point of
> producing the merged document ...this would be the cleanest
> solution from
> the user standpoint ...they'd just get four print-jobs
> instead of one ...but
> I'm not a Word guru by any means and have no clue how to do
> that in the VERY
> short timeframe I have to work with ...but if there is a Word
> guru out there
> my current code is:
>
> Function BuyerBadges()
> Dim objWord As Word.Document
> Set objWord = GetObject("F:\Document Masters\Buyer
> Documents\BuyerBadges.doc", "Word.Document")
> ' Make Word visible.
> objWord.Application.Visible = True
> ' Set the mail merge data source as the JemsXP database.
> objWord.MailMerge.OpenDataSource _
> Name:="C:\Program Files\JemsXP\JemsXP.mdb", _
> LinkToSource:=True, _
> Connection:="TABLE tblTempBuyerBadges", _
> SQLStatement:="Select * from [tblTempBuyerBadges] WHERE
> (((tblTempBuyerBadges.PrintFlag)= True))"
> ' Execute the mail merge.
> objWord.MailMerge.Execute
> End Function
>
> ...assuming I can't successfully split the document at the
> merge point, it
> seems that selecting only a partial range of records to print
> at one time is
> the next best solution ...it isn't very user friendly but if
> it'll work,
> that's life. I currently use a "Select" button on a
> continuous form to set a
> print flag on every record in a temp table and then use the
> Print Flag as
> the where condition in the merge sql as above ...individual
> records can be
> selected from the bound form as well but I can't very well
> ask the users to
> click on a thousand individual records ...so I need to change
> the select
> code below to pick a range of records to print as well as
> retain a "Print
> All" option. ...the thing is I'm brain dead at the moment and
> can't think of
> how best to go about implementing it ...any help for the
> battle weary would
> be deeply appreciated ...I have to have this working eleven
> short hours from
> now :((((((
>
> Private Sub cmdSelect_Click()
> On Error GoTo Err_cmdSelect_Click
>
> DoCmd.SetWarnings False
> DoCmd.OpenQuery "qryBuyerBadgesSelect"
> DoCmd.SetWarnings True
> Me.Refresh
>
> Exit_cmdSelect_Click:
> Exit Sub
>
> Err_cmdSelect_Click:
> MsgBox err.Description
> Resume Exit_cmdSelect_Click
>
> End Sub
>
> Private Sub cmdPrintSelected_Click()
> DoCmd.RunCommand acCmdSaveRecord
> DoCmd.Close acForm, "frmBuyerBadges"
> BuyerBadges
>
> End Sub
>
> William Hindman
> So, then, to every man his chance -- to every man, regardless
> of his birth,
> his shining golden opportunity -- to every man his right to
> live, to work,
> to be himself, to become whatever his manhood and his vision
> can combine to
> make him -- this, seeker, is the promise of America.
> -- Thomas Wolfe
>
>
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: winmail.dat
Type: application/ms-tnef
Size: 5696 bytes
Desc: not available
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030821/2c62b2a2/attachment-0001.bin>