|
|
|
date: Fri, 4 Jul 2008 00:47:02 -0700,
group: microsoft.public.word.vba.general
back
Re: Program to mail merge attachments
First off Thank you for the link it was helpful. The only ways I have gotten
this to work is by using the routing slip and by using two save locations.
The first is less than ideal as I cannot add a e-mail body message and the
second gets away from the only having one file. The one aspect of the
mailmerge that I really like is the external maintenance of the e-mail list.
That way the end user could maintain the list and not have to know anything
about vba. I am going to keep playing with the code to see if I can achieve
all my objectives.
Thanks again for your help. Any insight to my below code would be greatly
appreciated. I have the mailmerge and send document as attachment subs in
the code but do not call them.
Option Explicit
Public bSignFormOK As Boolean
Public bMSignFormOK As Boolean
Public myDoc As Document
Public DHForm As UserForm1
Public DHMForm As UserForm2
Dim DHRepCmbBxVal As String
Dim DHMgrCmbBxVal As String
Sub AutoNew()
Set myDoc = ActiveDocument
Set DHForm = New UserForm1
Load DHForm
DHForm.Show
If bSignFormOK = True Then
CollectDHFormValues
Unload DHForm
Set DHForm = Nothing
Else
Unload DHForm
Set DHForm = Nothing
End If
If bSignFormOK = True Then BuildDoc Else myDoc.Close wdDoNotSaveChanges
End Sub
Sub MgrReview()
Set myDoc = ActiveDocument
Set DHMForm = New UserForm2
Load DHMForm
DHMForm.Show
If bMSignFormOK = True Then
CollectDHMFormValues
Unload DHMForm
Set DHMForm = Nothing
Else
Unload DHMForm
Set DHMForm = Nothing
End If
If bMSignFormOK = True Then AddMgrValues Else myDoc.Close
wdDoNotSaveChanges
End Sub
Private Sub CollectDHFormValues()
With DHForm
DHRepCmbBxVal = .RepNameCmbBx.Value
End With
End Sub
Private Sub CollectDHMFormValues()
With DHMForm
DHMgrCmbBxVal = .MgrNameCmbBx.Value
End With
End Sub
Sub BuildDoc()
If myDoc.ProtectionType <> wdNoProtection Then myDoc.Unprotect "inquiry"
InsertBookmarkValue "Report1", "Yes"
InsertBookmarkValue "Report2", "Yes"
InsertBookmarkValue "Report3", "Yes"
InsertBookmarkValue "Report4", "Yes"
InsertBookmarkValue "Report5", "Yes"
InsertBookmarkValue "Report6", "Yes"
InsertBookmarkValue "Report7", "Yes"
InsertBookmarkValue "Report8", "Yes"
InsertBookmarkValue "Report9", "Yes"
InsertBookmarkValue "Report10", "Yes"
InsertBookmarkValue "Report11", "Yes"
InsertBookmarkValue "Report12", "Yes"
InsertBookmarkValue "Report13", "Yes"
InsertBookmarkValue "Report14", "Yes"
InsertBookmarkValue "Report15", "Yes"
InsertBookmarkValue "Report16", "Yes"
InsertBookmarkValue "Report17", "Yes"
InsertBookmarkValue "RepName", DHRepCmbBxVal
With ActiveWindow.View
.ShowBookmarks = False
.ShowHiddenText = False
.ShowAll = False
End With
myDoc.Protect wdAllowOnlyFormFields, True, "inquiry"
' myDoc.SaveAs FileName:="Q:\Inquiry Research\Templates\Daily Holdover
Report Checklist.doc", Fileformat:=wdFormatDocument
' EmailMergeWithAttachment
' SendDocumentAsAttachment
myDoc.HasRoutingSlip = True
With myDoc.RoutingSlip
.Subject = "Please Complete the Manager Review of the Daily Holdover
Checklist."
.AddRecipient "first.last@alliancebernstein.com"
.Delivery = wdAllAtOnce
End With
myDoc.Route
End Sub
Sub AddMgrValues()
If myDoc.ProtectionType <> wdNoProtection Then myDoc.Unprotect "inquiry"
InsertBookmarkValue "ReportM1", "Yes"
InsertBookmarkValue "ReportM2", "Yes"
InsertBookmarkValue "ReportM3", "Yes"
InsertBookmarkValue "ReportM4", "Yes"
InsertBookmarkValue "ReportM5", "Yes"
InsertBookmarkValue "ReportM6", "Yes"
InsertBookmarkValue "ReportM7", "Yes"
InsertBookmarkValue "ReportM8", "Yes"
InsertBookmarkValue "ReportM9", "Yes"
InsertBookmarkValue "ReportM10", "Yes"
InsertBookmarkValue "ReportM11", "Yes"
InsertBookmarkValue "ReportM12", "Yes"
InsertBookmarkValue "ReportM13", "Yes"
InsertBookmarkValue "ReportM14", "Yes"
InsertBookmarkValue "ReportM15", "Yes"
InsertBookmarkValue "ReportM16", "Yes"
InsertBookmarkValue "ReportM17", "Yes"
InsertBookmarkValue "MgrName", DHMgrCmbBxVal
With ActiveWindow.View
.ShowBookmarks = False
.ShowHiddenText = False
.ShowAll = False
End With
myDoc.Protect wdAllowOnlyFormFields, True, "inquiry"
myDoc.SaveAs FileName:="Q:\Inquiry Research\Templates\Daily Holdover
Report Checklist.doc", Fileformat:=wdFormatDocument
End Sub
Sub InsertBookmarkValue(BkmkName As String, Value As String)
With myDoc
If .Bookmarks.Exists(BkmkName) = True Then
Dim myRange As Range
Set myRange = .Bookmarks(BkmkName).Range
myRange.Text = Value
.Bookmarks.Add BkmkName, myRange
End If
End With
End Sub
Sub EmailMergeWithAttachment()
Dim mySource As Document, myMailList As Document
Dim myRange As Range
Dim myCounter As Integer, i As Integer
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mySubject As String, myBody As String
Set mySource = ActiveDocument
'Check if outlook is running. If not, then start Outlook
bStarted = False
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'Open the catalog mailmerge document
Documents.Open FileName:="Q:\Inquiry Research\Templates\Email List.Doc"
Set myMailList = ActiveDocument
'Set Email subject and body
mySubject = "Please Complete the Manager Review of the Daily Holdover
Report Checklist"
myBody = "Please complete the Manager Review of the Daily Holdover
Report Checklist. Open the attached file and hit [Ctrl + Alt + `]. The '`'
key is on the left of the keyboard above the tab."
'Iterate through the rows of the catalog mailmerge document, extratcting the
information
'to be included in each email
myCounter = 1
While myCounter <= myMailList.Tables(1).Rows.Count
myDoc.Sections.First.Range.Cut
Documents.Add
Selection.Paste
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = mySubject
.Body = myBody
Set myRange = myMailList.Tables(1).Cell(myCounter, 1).Range
myRange.End = myRange.End - 1
.To = myRange
For i = 2 To myMailList.Tables(1).Columns.Count
Set myRange = myMailList.Tables(1).Cell(myCounter, i).Range
myRange.End = myRange.End - 1
.Attachments.Add Trim(myRange.Text), olByValue, 1
Next i
.Send
End With
Set oItem = Nothing
myCounter = myCounter + 1
Wend
'Close Outlook if it was started by this macro
If bStarted Then oOutlookApp.Quit
'Clean up
Set oOutlookApp = Nothing
myDoc.Close wdDoNotSaveChanges
myMailList.Close wdDoNotSaveChanges
End Sub
Sub SendDocumentAsAttachment()
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.To = "first.last@alliancebernstein.com"
.Subject = "Please Complete the Manager Review of the Daily Holdover
Checklist."
.Body = "Please complete the Manager Review of the Daily Holdover
Report Checklist. Open the attached file and hit [Ctrl + Alt + `]. The '`'
key is on the left of the keyboard above the tab."
.Attachments.Add Source:="Q:\Inquiry Research\Templates\Daily
Holdover Report Checklist.doc", Type:=olByValue
.Send
End With
If bStarted Then oOutlookApp.Quit
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub
"Doug Robbins - Word MVP" wrote:
> For a single document, I would not be using the mail merge with attachment
> utility.
>
> See the article "How to send an email from Word using VBA" at:
>
> http://www.word.mvps.org/FAQs/InterDev/SendMail.htm
>
> If you want to show us your code, copy and paste it into a message that you
> post back here.
>
>
> --
> Hope this helps.
>
> Please reply to the newsgroup unless you wish to avail yourself of my
> services on a paid consulting basis.
>
> Doug Robbins - Word MVP
>
> "Rand8203" wrote in message
> news:C2AE3CAE-DF99-40C3-941B-839E45096DAA@microsoft.com...
> > Hello,
> >
> > I have incorporated the email merge attachment procedure into a template I
> > have create and I am having some trouble. In my template I have one user
> > enter some information via a form and then the template saveas to a word
> > document at a location I selected. I then use the email merge attachment
> > procedure to e-mail the saved word document to a second user who then
> > enters
> > some additional information and then the word document saveas the same
> > file
> > as before. The issue is I am getting a message indicating that the file I
> > am
> > saving to is being used by a program and cannot be saved over. If I
> > remove
> > the email merge attachment procedure I am able to run both user's parts.
> > It
> > appears that the email merge attachement procedure causes a tmp file to be
> > created for the document as it is being attached, for a loss/recovery
> > action,
> > as an improper closing of the file would have. Is there a way around this
> > automatically? So the user does not have to go a delete the tmp file? I
> > don't
> > want to save to a different filename if it can be avoided.
> >
> > If needed I can e-mail the template so my code can be examined in greater
> > detail.
> >
> > "Doug Robbins - Word MVP" wrote:
> >
> >> You can mail merge to email with attachments by following the procedure
> >> in
> >> the article "Mail Merge to E-mail with Attachments" at:
> >>
> >> http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.htm
> >>
> >> But it still requires you to navigate the "Outlook 'Allow' hurdle" that
> >> you
> >> were hoping to avoid.
> >>
> >> --
> >> Hope this helps.
> >>
> >> Please reply to the newsgroup unless you wish to avail yourself of my
> >> services on a paid consulting basis.
> >>
> >> Doug Robbins - Word MVP
> >>
> >> "Rayashe" wrote in message
> >> news:5E68B247-D355-4D4C-9057-EEC74EDDCCF5@microsoft.com...
> >> > Is there some VBA code that can be executed so that a mail merge can be
> >> > done
> >> > to email as an attachment and get around the Outlook 'Allow' hurdle?
> >>
> >>
> >>
>
>
>
date: Thu, 4 Sep 2008 19:27:01 -0700
author: Rand8203
|
|
