Scribd
Upload
54 views2 pages

Automate Email Sending with Attachments

This macro loops through sections in a source document and rows in a mail merge document to send individual emails. It gets the subject from the user, sets the body to the section text, sets the To field to the first cell, and attaches files from subsequent cells before sending each email.

Uploaded by

Yiyo Roa
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
54 views2 pages

Automate Email Sending with Attachments

This macro loops through sections in a source document and rows in a mail merge document to send individual emails. It gets the subject from the user, sets the body to the section text, sets the To field to the first cell, and attaches files from subsequent cells before sending each email.

Uploaded by

Yiyo Roa
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd

Sub adjuntararchivos()

Dim Source As Document, Maillist As Document, TempDoc As Document

Dim Datarange As Range

Dim i As Long, j As Long

Set objEmail = CreateObject("[Link]")

[Link] = "[Link]@[Link]"

Dim bStarted As Boolean

Set oOutlookApp = CreateObject("[Link]")

' Dim oItem As [Link]

Dim mysubject As String, message As String, title As String

Set Source = ActiveDocument

' Check if Outlook is running. If it is not, start Outlook

On Error Resume Next

Set oOutlookApp = GetObject(, "[Link]")

If Err <> 0 Then

Set oOutlookApp = CreateObject("[Link]")

bStarted = True

End If

' Open the catalog mailmerge document

With Dialogs(wdDialogFileOpen)

.Show

End With

Set Maillist = ActiveDocument

' Show an input box asking the user for the subject to be inserted into the email messages

message = "Enter the subject to be used for each email message." ' Set prompt.

title = " Email Subject Input" ' Set title.

' Display message, title

mysubject = InputBox(message, title)

' Iterate through the Sections of the Source document and the rows of the catalog mailmerge
document,

' extracting the information to be included in each email.


For j = 1 To [Link] - 1

Set oItem = [Link](olMailItem)

With oItem

.Subject = mysubject

.Body = [Link](j).[Link]

Set Datarange = [Link](1).Cell(j, 1).Range

[Link] = [Link] - 1

.To = Datarange

For i = 2 To [Link](1).[Link]

Set Datarange = [Link](1).Cell(j, i).Range

[Link] = [Link] - 1

.[Link] Trim([Link]), olByValue, 1

Next i

.Send

End With

Set oItem = Nothing

Next j

[Link] wdDoNotSaveChanges

' Close Outlook if it was started by this macro.

If bStarted Then

[Link]

End If

MsgBox [Link] - 1 & " messages have been sent."

'Clean up

Set oOutlookApp = Nothing

End Sub

You might also like