Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
"Mail Merge to E-Mail with Attachments" questions
I am using the "Mail Merge to E-Mail with Attachments" macro witout success.
The macro appears to run three times (the number of e-mail addresses I am using to test), but the test e-mail accounts do not receive the message. Furthermore, I do NOT have messages in mu Outlook Outbox or sent messages folder. Did I inadvertently alter the macro? For the life of me, I can't find the typo! Here 'tis: Sub EMailMergeWithAttachments() Dim Source As Document Dim MailList As Document Dim DataRange As Range Dim Counter As Integer Dim i As Integer Dim bStarted As Boolean Dim oOutlookApp As Outlook.Application Dim oItem As Outlook.MailItem Dim MySubject As String Dim Message As String Dim Title As String Set Source = ActiveDocument 'Check if Outlook is running. Start it if it is not. On Error Resume Next If Err 0 Then Set oOutlookApp = CreateObject("Outlook.Application") bStarted = True End If 'Open the Catalog Mail Merge Document With Dialogs(wdDialogFileOpen) .Show End With Set MailList = ActiveDocument 'Show an Input box for the e-mail subject line Message = "Enter the subject to be used for each e-mail message" 'Set the dialog box prompt Title = "E-Mail Subject Line:" MySubject = InputBox(Message, Title) 'Iterate through the rows of the catalog mailmerge, 'extracting the info for the message Counter = 1 While Counter = MailList.Tables(1).Rows.Count Source.Sections.First.Range.Cut Documents.Add Selection.Paste Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem .Subject = MySubject .Body = ActiveDocument.Content Set DataRange = MailList.Tables(1).Cell(Counter, 1).Range DataRange.End = DataRange.End - 1 .to = DataRange For i = 2 To MailList.Tables(1).Columns.Count Set DataRange = MailList.Tables(1).Cell(Counter, i).Range DataRange.End = DataRange.End - 1 .Attachments.Add Trim(DataRange.Text), olByValue, 1 Next i .Send End With Set oItem = Nothng ActiveDocument.Close wdDoNotSaveChanges Counter = Counter + 1 Wend 'Close Outlook if started by the macro If bStarted Then oOutlookApp.Quit End If 'Clean Up Set oOutlookApp = Nothing Source.Close wdDoNotSaveChanges MailList.Close wdDoNotSaveChanges End Sub ***** Any help is appreciated. Thanks! |
#2
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
"Mail Merge to E-Mail with Attachments" questions
Looks OK.
Try sticking a MsgBox DataRange before ..to = DataRange and make sure that it is being populated with a valid email address. -- 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 "Dan" wrote in message ... I am using the "Mail Merge to E-Mail with Attachments" macro witout success. The macro appears to run three times (the number of e-mail addresses I am using to test), but the test e-mail accounts do not receive the message. Furthermore, I do NOT have messages in mu Outlook Outbox or sent messages folder. Did I inadvertently alter the macro? For the life of me, I can't find the typo! Here 'tis: Sub EMailMergeWithAttachments() Dim Source As Document Dim MailList As Document Dim DataRange As Range Dim Counter As Integer Dim i As Integer Dim bStarted As Boolean Dim oOutlookApp As Outlook.Application Dim oItem As Outlook.MailItem Dim MySubject As String Dim Message As String Dim Title As String Set Source = ActiveDocument 'Check if Outlook is running. Start it if it is not. On Error Resume Next If Err 0 Then Set oOutlookApp = CreateObject("Outlook.Application") bStarted = True End If 'Open the Catalog Mail Merge Document With Dialogs(wdDialogFileOpen) .Show End With Set MailList = ActiveDocument 'Show an Input box for the e-mail subject line Message = "Enter the subject to be used for each e-mail message" 'Set the dialog box prompt Title = "E-Mail Subject Line:" MySubject = InputBox(Message, Title) 'Iterate through the rows of the catalog mailmerge, 'extracting the info for the message Counter = 1 While Counter = MailList.Tables(1).Rows.Count Source.Sections.First.Range.Cut Documents.Add Selection.Paste Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem .Subject = MySubject .Body = ActiveDocument.Content Set DataRange = MailList.Tables(1).Cell(Counter, 1).Range DataRange.End = DataRange.End - 1 .to = DataRange For i = 2 To MailList.Tables(1).Columns.Count Set DataRange = MailList.Tables(1).Cell(Counter, i).Range DataRange.End = DataRange.End - 1 .Attachments.Add Trim(DataRange.Text), olByValue, 1 Next i .Send End With Set oItem = Nothng ActiveDocument.Close wdDoNotSaveChanges Counter = Counter + 1 Wend 'Close Outlook if started by the macro If bStarted Then oOutlookApp.Quit End If 'Clean Up Set oOutlookApp = Nothing Source.Close wdDoNotSaveChanges MailList.Close wdDoNotSaveChanges End Sub ***** Any help is appreciated. Thanks! |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Mail Merge Word 2003 Issue | Mailmerge | |||
Problem: Mail Merge with Fill-ins asks for fill-in value for every label, not just once | Mailmerge | |||
Mail Merge can't find data source in Office XP...but it could in 2000! | Mailmerge | |||
Mail Merge Losing Data | Mailmerge | |||
How do I make footnote numners static in a mail merge document? | Mailmerge |