Macro to send emails in batches.

[dilipsunder]

Hello Guys

I have a macro to send emails from excel, the below macro sends emails with details in the excel sheet.

The excel sheet has name,email id's,path of the pdf file to attach and body of the email in separate columns.

What i need help is

1. To send emails in batches.(10 or 15 emails should be sent with every click.)
2. Can the macro in excel instruct outlook send the mail automatically rather than the user click on send button.


Thanks in advance for your time and support.

Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim strbody As String

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)


Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Dear Patrons"
.Body = strbody
With ThisWorkbook.Sheets("Sheet1")

strbody = "Dear Patron" & vbNewLine & vbNewLine & _
.Range("G2") & vbNewLine & _
.Range("G3") & vbNewLine & _
.Range("G4") & vbNewLine & _
.Range("G5") & vbNewLine & _
.Range("G6")

End With

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Display 'Or use Send
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[Sonofawhatthe]

I may not be reading your question correctly.. but here is some code I use to automate the sending of email from a web page using VB. This sorts thrugh

' Set the mail server configuration
Set objConfig=CreateObject("CDO.Configuration")
objConfig.Fields.Item(sendUrl)=2 ' cdoSendUsingPort
objConfig.Fields.Item(smtpUrl)="relay-hosting.secureserver.net"
objConfig.Fields.Item(timeoutUrl)=60
objConfig.Fields.Update
' Create and send the mail
Set objMail=CreateObject("CDO.Message")
' Use the config object created above
Set objMail.Configuration=objConfig
objMail.From = "[email protected]"
objMail.To = myemail
objMail.Subject = "TestSubject " & mySubject
objMail.TextBody = mailmsg
objMail.Send

set objMail = nothing
set objConfig = nothing