Option Explicit



Declare Function ShellExecute Lib "shell32.dll" _

    Alias "ShellExecuteA" ( _

    ByVal hwnd As Long, _

    ByVal lpOperation As String, _

    ByVal lpFile As String, _

    ByVal lpParameters As String, _

    ByVal lpDirectory As String, _

    ByVal nShowCmd As Long) As Long



'// My thanks to Jay Kreusch

'// amendments IFM

Public Function QuickMail(ByVal vTo As Variant, _

    Optional ByVal vCC As Variant, _

    Optional ByVal vBCC As Variant, _

    Optional ByVal tmpSubject As String, _

    Optional ByVal tmpBody As String) As String



Dim strTo      As String

Dim strCC      As String

Dim strBCC     As String

Dim strSubject As String

Dim strBody    As String

Dim strMailTo  As String



'// see what kind of variable was passed in to the variant

Select Case VarType(vTo)

    '// if just a string, use it

    Case vbString

        strTo = vTo

        'if an array, join it into a string

    Case vbArray + vbString

        strTo = Join(vTo, ";")

        'raise an "error"

    Case Else

        QuickMail = "ERROR: vTo Invalid Data Type"

        Exit Function

End Select





Select Case VarType(vCC)

    Case vbString

        strCC = "&cc=" & vCC

    Case vbArray + vbString

        strCC = "&cc=" & Join(vCC, ";")

    Case vbError

        strCC = vbNullString

    Case Else

        QuickMail = "ERROR: vCC Invalid Data Type"

    Exit Function

End Select





Select Case VarType(vBCC)

    Case vbString

        strBCC = "&bcc=" & vBCC

    Case vbArray + vbString

        strBCC = "&bcc=" & Join(vBCC, ";")

    Case vbError

        strBCC = vbNullString

    Case Else

        QuickMail = "ERROR: vBCC Invalid Data Type"

    Exit Function

End Select





If tmpSubject <> vbNullString Then

    strSubject = "&subject=" & tmpSubject

Else

    strSubject = vbNullString

End If



If tmpBody <> vbNullString Then

    strBody = "&body=" & tmpBody

Else

    strBody = vbNullString

End If



strMailTo = "mailto:" & strTo & strSubject & strBody & strCC & strBCC



Call ShellExecute(0&, _

    vbNullString, _

    strMailTo, _

    vbNullString, _

    vbNullString, _

    vbNormalFocus)



End Function





Sub SendEmail()

Dim strTo(1 To 4) As String

Dim strSubject As String

Dim strBody As String

Dim strMessages As String

Dim strCC(1 To 4) As String

Dim strBCC As String

Dim intX As Integer



'this function allows you to pass an

'array of strings, or just a regular string

'using an array:

strTo(1) = "ivanmoala@xtra.co.nz"

strTo(2) = "scott@mrexcel.com"

strTo(3) = "corosuke@chan.co.jp"

strTo(4) = "maymoala@xtra.co.nz"



'assign your subject and body

strSubject = "This is a test!!"

strBody = "Body of text goes here....wow it works!"



'Creating an array

For intX = 1 To 4

    strCC(intX) = "BulkUsers_" & intX & "@domain.com"

Next



'using a normal string (separate with semicolons)

strBCC = "corosuke@chan.co.jp;dennis@xldennis.com;scott@mrexcel.com"



'call the function

strMessages = QuickMail(strTo(), strCC(), strBCC, strSubject, strBody)



'see if it passed back an error

If strMessages <> "" Then

    MsgBox strMessages

End If



End Sub