How do I have VBA send an email to multiple recipients

I have written a bit of code to be able to copy the visible rows of the first worksheet to a new workbook and then be able to send the workbook to 1 recipient, I only want to be able, preferably via an inputbox, to select multiple recipients I'll put down the code as I have it now.

Code:

---

Sub sendmail()
  Dim fsoObj As Object
  Dim Fs As Object
  Dim strPath As String
  Dim strFileMask As String
  Dim f As String
  Dim stKallFil As String
  Dim recipients As String
  Dim weeknummer As Range
  Dim week As Range
  Set fsoObj = CreateObject("Scripting.FileSystemObject")
Set week = Worksheets("totaal").Range("h1")
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If MsgBox(strExcelApp & "Onderhoudsgegevens versturen?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
With fsoObj
        If .FolderExists("c:\tempmail\") Then
Else
.CreateFolder ("c:\tempmail\")
        End If
Application.ScreenUpdating = False
Dim Wkb            As Workbook
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy
    Set Wkb = Workbooks.Add
    Wkb.Sheets(1).Paste
Application.CutCopyMode = False
    Dim Shp            As Shape
 For Each Shp In Wkb.Sheets(1).Shapes
    Shp.Delete
Next
    Set Wkb = Nothing
        recipients = InputBox(Prompt:="Voer adres ontvanger in", Default:="user@domain.com")
        ActiveWorkbook.Sheets("blad1").Columns("A").AutoFit
        ActiveWorkbook.SaveAs Filename:="C:\tempmail\onderhoud na week " & week & ".xls", CreateBackup:=False
        ActiveWorkbook.sendmail recipients, "Te plegen onderhoud na week " & week
        ActiveWindow.Close
On Error Resume Next
        Kill "C:\tempmail\*.*"
        RmDir "C:\tempmail"
End With
Set fsoObj = Nothing
End Sub

---

Now i have another question regarding this, would it be able to have the sheet that I have exported to a new workbook instead export it to Word and then lose the excel look (so no more fancy tables).

TIA
frank

Hi,

as you want to send it to multiple recipients you just need to create a loop like this:

Code:

---

Set Wkb = Nothing
  Dim anot As vbMsgBoxResult
  anot = vbYes
  While anot = vbYes
        recipients = InputBox(Prompt:="Voer adres ontvanger in", Default:="user@domain.com")
        ActiveWorkbook.Sheets("blad1").Columns("A").AutoFit
        ActiveWorkbook.SaveAs Filename:="C:\tempmail\onderhoud na week " & week & ".xls", CreateBackup:=False
        ActiveWorkbook.sendmail recipients, "Te plegen onderhoud na week " & week
        anot = MsgBox("Do you want to send another e-mail?", vbYesNo, "e-mail")
  Wend

---

If you use Outlook, you might give this KB-entry a try: http://www.vbaexpress.com/kb/getarticle.php?kb_id=326

And here's how I modified it to send a mail to 2 persons:

Code:

---

Option Explicit

Sub EmailWithOutlook()
    'Variable declaration
    Dim oApp As Object, _
    oMail As Object, _
    WB As Workbook, _
    FileName As String
'Turn off screen updating
    Application.ScreenUpdating = False
'Make a copy of the active sheet and save it to
    'a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook
    FileName = "Temp.xls"
    On Error Resume Next
    Kill "C:\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:="C:\" & FileName
'Create and show the outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        'Uncomment the line below to hard code a recipient
        .To = "me@here.com; me@somewhereelse.com"
        'Uncomment the line below to hard code a subject
        .Subject = "Look at my workbook!"
        .Attachments.Add WB.FullName
        'Send it right away, use .Display to just show the mail
        .send
    End With
'Delete the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
   
    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub

---

If you don't use Outlook, you might give http://www.vbaexpress.com/kb/getarticle.php?kb_id=311 a try.

Daniel

So Frank,

is it solved??

Yes thanks, sorry i forgot to mark it solved, i used your solution since the inputboxes are by far the easiest way to have a user input in excel.

I'll mark it solved straight away, thanks for your help.

frank