Option Compare Database
Option Explicit

Public Function ReadUntil(ByRef sIn As String, sDelim As String, Optional bCompare As Integer = vbBinaryCompare) As String
  Dim nPos As String

  nPos = InStr(1, sIn, sDelim, bCompare)

  If nPos > 0 Then
    ReadUntil = Left(sIn, nPos - 1)
    sIn = Mid(sIn, nPos + Len(sDelim))
  End If
End Function
      

Public Function Split(ByVal sIn As String, Optional sDelim As String, Optional nLimit As Long = -1, Optional bCompare As Integer = vbBinaryCompare) As Variant

Dim sRead As String, sOut() As String, nC As Integer
  If sDelim = "" Then
    Split = sIn
  End If
  
  sRead = ReadUntil(sIn, sDelim, bCompare)
  
  Do
    ReDim Preserve sOut(nC)
    sOut(nC) = sRead
    nC = nC + 1
    If nLimit <> -1 And nC >= nLimit Then Exit Do
    sRead = ReadUntil(sIn, sDelim)
  Loop While sRead <> ""
  
  ReDim Preserve sOut(nC)
  sOut(nC) = sIn
  Split = sOut
End Function



Public Function SendOutlookMail(ByVal strSubject As String, ByVal strBody As String, ByVal strRecipients As String, Optional ByVal strAttachments As String = "", Optional ByVal bolPreview As Boolean = False)
Dim golApp As Object
Dim objNewMail As Object
Dim Recipients As Variant
Dim Attachments As Variant
Dim i As Integer


Set golApp = CreateObject("Outlook.Application")
Set objNewMail = golApp.CreateItem(0)
objNewMail.Subject = strSubject
objNewMail.Body = strBody

Recipients = Split(strRecipients, ";")
For i = LBound(Recipients) To UBound(Recipients)
   If Recipients(i) <> "" Then
     objNewMail.Recipients.Add (Recipients(i))
   End If
Next

If strAttachments <> "" Then
  Attachments = Split(strAttachments, ";")

  For i = LBound(Attachments) To UBound(Attachments)
    If Attachments(i) <> "" Then
      objNewMail.Attachments.Add (Attachments(i))
    End If
  Next
  
End If

If bolPreview = True Then
  objNewMail.Display
Else
  objNewMail.Send
End If

Set golApp = Nothing
Set objNewMail = Nothing

End Function