I'm using Access & Word to e-mail merge about 3000 records to a letter to be
distributed by department heads to about 3000 individuals. I need to e-mail
each department head their merged file of letters (each has between 15 - 300
reocrds in the merge). I can't figure out how to do it except by merging each
letter as a separate e-mail?! Not an option, filling up people's e-mail boxes
with 300 e-mail attachments to download and print.

Please advise. (VBA/Macros, etc. are not my forte but I can paste & copy!).

You could try adapting the following code. It assumes you are using Word
2002/2003 and Outlook. You need to go thrgh the code thoroughly and write
the SQL appropriate for your data, etc. etc.

Sub SendMultiLetterMergeToEmail()
' Macro by PJ Jamieson 15 Apr 2005
' Performs one multi-letter merge for each department head
' then e-mails the resulting file
' In the VBA Editor, you need to use Tools|References to
' set references to
' Microsoft ActiveX Data Objects a.b Library
' (on my system the latest a.b is 2.8)
' Microsoft Outlook c.d Object Library
' (on my system c.d is 11.0 for Outlook 2003)

Dim i As Long

' Variables for our Department info.
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim oField As ADODB.Field
Dim sDepartmentDBName As String
Dim sDepartmentConnection As String
Dim sDepartmentSQL As String
Dim sDepartmentID As String
Dim sDepartmentHeadEmail As String

' Variables for our merge
Dim oDoc As Word.Document
Dim sMailMergeName As String
Dim sMailMergeConnection As String
Dim sMailMergeSQL As String

' Variables for e-mail
Dim bOutlookStarted As Boolean
' Dim oMailDoc As Word.Document
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim sSavedDocumentPath As String

' Set a reference to the mail merge main document
i = 0
' substitute your database pathname here
sDepartmentDBName = "c:\mydbs\my.mdb"
' you may need more in this string
sDepartmentConnection = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDepartmentDBName & ";" & _
"Persist Security Info=False"

' For OLEDB connections in Word 2003 Mailmerge
' the following will probably work

sMailMergeName = sDepartmentDBName
sMailMergeConnection = ""

' However, if you need a more complex connection string
' for workgroup security etc., you can try...

' sMailMergeName = sDepartmentDBName
' sMailMergeConnection = sDepartmentConnection

' However, I suspect that in that case you will probably need
' to set the databasename to either a .odc or .udl file that
' you will need to create, and I don't cater for that here.

' I do not expect it the above to work in Word 2000
' or earlier because Word Mailmerge cannot use OLEDB
' and by default will try to open the database using DDE
' and that will probably fail because it his already been opened
' using an incompatible method.

' First, ensure Outlook has started

bOutlookStarted = False
On Error Resume Next

' Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err 0 Then
' Outlook wasn't running, start it from code
Set oOutlookApp = CreateObject("Outlook.Application")
bOutlookStarted = True
Err.Clear
End If

' You probably need better error handling than this! Up to you.
On Error GoTo 0

' Usually best to set our own references to ActiveDocument etc.

Set oDoc = ActiveDocument
With oDoc.MailMerge

' remove any merge connection before attempting any
' new connections

.MainDocumentType = wdNotAMergeDocument

' make an ADO connection and retrieve the list of email addresses

Set oConn = New ADODB.Connection
'
oConn.ConnectionString = sDepartmentHeadConnection
oConn.Open
Set oRS = New ADODB.Recordset

' Substitute your own SQL that retrieves a list of
' Departments and the emails for their Heads. You will need at least their
email address
' and whatever identifier is used in the table/query used in the
' mail merge data source.
sDepartmentSQL = _
"SELECT DISTINCT DepartmentID, DepartmentHeadEmail " & _
"FROM Departments"

' Get the list of Department Heads
oRS.Open Source:= _
sDepartmentHeadSQL, _
ActiveConnection:=oConn

' we could open the merge source here,
' and adjust it for each recipient by
' setting MailMerge.DataSource.QueryString
' but in this case I think it is probably
' better to disconnect/reconnect each time

' For each department head...

While Not oRS.EOF
i = i + 1
sDepartmentHeadEmail = oRS("DepartmentHeadEmail").Value
sDepartmentID = oRS("DepartmentID").Value
' disconnect, set the merge type and destination
' build the data source SQL and reconnect
.MainDocumentType = wdNotAMergeDocument
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
' Substitute your own SQL here
sMailMergeSQL = _
"SELECT * FROM `individuals` " & _
"WHERE `individuals`.`DepartmentID` = " & _
"'" & sDepartmentID & "'"

.OpenDataSource _
Name:=sMailMergeName, _
Connection:=sMailMergeConnection, _
sqlstatement:=sMailMergeSQL
.Execute

' The merge result is now the ActiveDocument.
' There are various ways to e-mail it.
' Personally I prefer to use a plain text body and
' send the document as an attachment.
' two methods that are easy to use from VBA are described at
' http://word.mvps.org/FAQs/InterDev/SendMail.htm
' and one is adapted for use here

' for this method we have to save the document.
' you can re-use the same document name, but here
' we save each document separately, but you can
' re-use the same name
sSavedDocumentPath = "c:\myoutput\output" & Trim(CStr(i)) & ".doc"
ActiveDocument.SaveAs FileName:=sSavedDocumentPath
ActiveDocument.Close savechanges:=wdDoNotSaveChanges

' Now send the document

' Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
' Set the recipient for the new email
.To = sDepartmentHeadEmail

' Set the recipient for a copy
' .CC = "

' Set your subject
.Subject = "New subject"
' Plain text body.
.Body = "Please find attached the ... for your department"
.Attachments.Add sSavedDocumentPath, olByValue, 1
.Send
End With
Set oItem = Nothing
' move to the next department
oRS.MoveNext
Wend
End With

' tidy up
If bOutlookStarted Then
oOutlookApp.Quit
End If
Set oOutlookApp = Nothing
oRS.Close
Set oRS = Nothing
oConn.Close
Set oConn = Nothing
Set oDoc = Nothing
End Sub


Peter Jamieson

"Plastic Graduate" Plastic wrote in
message ...
I'm using Access & Word to e-mail merge about 3000 records to a letter to
be
distributed by department heads to about 3000 individuals. I need to
e-mail
each department head their merged file of letters (each has between 15 -
300
reocrds in the merge). I can't figure out how to do it except by merging
each
letter as a separate e-mail?! Not an option, filling up people's e-mail
boxes
with 300 e-mail attachments to download and print.

Please advise. (VBA/Macros, etc. are not my forte but I can paste &
copy!).