Declare Function MAPISendMail Lib "C:Arquivos de programasOutlook ExpressMsoe.dll" _
Alias "BMAPISendMail" _
(ByVal Session&, ByVal UIParam&, Message As MAPIMessage, _
Recipient() As MapiRecip, File() As MapiFile, ByVal flags&, _
ByVal Reserved&) As Long

 

Public Function SendMail(sSubject As String, sTo As String, sCC As String, sCCO As String, sAttach As String, sMessage As String)

   On Error GoTo Err_CapturarError
  
   Dim i, cTo, cCC, cCCO, cAttach ' contadores de items
   Dim MAPI_Message As MAPIMessage
   ' Contar el número de items en cada lista
   cTo = CountTokens(sTo, ";")
   cCC = CountTokens(sCC, ";")
   cCCO = CountTokens(sCCO, ";")
   cAttach = CountTokens(sAttach, ";")
   ' Dimensionar las matrices para las listas
   ReDim rTo(0 To cTo) As String
   ReDim rCC(0 To cCC) As String
   ReDim rCCO(0 To cCCO) As String
   ReDim rAttach(0 To cAttach) As String
   ' Pasar el contenido de las listas a las matrices
   ParseTokens rTo(), sTo, ";"
   ParseTokens rCC(), sCC, ";"
   ParseTokens rCCO(), sCCO, ";"
   ParseTokens rAttach(), sAttach, ";"
   ' Crear la estructura MAPI Recip para almacenar todos los destinatarios
   ReDim MAPI_Recip(0 To cTo + cCC + cCCO - 1) As MapiRecip
   ' Cargar los "TO:" en la estructura
   For i = 0 To cTo - 1
   MAPI_Recip(i).Name = rTo(i)
   MAPI_Recip(i).RecipClass = MAPI_TO
   Next i
   ' Cargar los "CC:"
   For i = 0 To cCC - 1
   MAPI_Recip(cTo + i).Name = rCC(i)
   MAPI_Recip(cTo + i).RecipClass = MAPI_CC
   Next i
   ' Cargar los "CCO:"
   For i = 0 To cCCO - 1
   MAPI_Recip(cTo + cCC + i).Name = rCCO(i)
   MAPI_Recip(cTo + cCC + i).RecipClass = MAPI_CCO
   Next i
   ' Crear la estructura MAPI_File para los adjuntos
   ReDim MAPI_File(0 To cAttach) As MapiFile
   ' Cargar los adjuntos en la estructura
   MAPI_Message.FileCount = cAttach
   For i = 0 To cAttach - 1
   MAPI_File(i).Position = -1
   MAPI_File(i).PathName = rAttach(i)
   Next i
   ' Llenar los campos del mensaje
   MAPI_Message.Subject = sSubject
   MAPI_Message.NoteText = sMessage
   MAPI_Message.RecipCount = cTo + cCC + cCCO
   ' Enviar el mensaje
   SendMail = MAPISendMail(0&, 0&, MAPI_Message, MAPI_Recip(), _
   MAPI_File(), MAPI_LOGON_UI, 0&)
  
Saida:
   Exit Function
  
Err_CapturarError:
   Select Case Err.Number
         Case 2
              MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & "Verifique a origem do arquivo anexado. ", vbCritical, "ERRO"
         Case 48
              MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
              & "Não foi possível carregar MSOE.DLL", 16, "ERRO"
              SendMail = 48
         Case 453
              MsgBox "Error nº.: " & lngRet & " (de MSAccess), ao enviar email." & vbCr & vbCr _
              & "MAPI32X.DLL, não é a versão correta.", vbCritical, "ERRO"
              SendMail = 453
         Case -2147467259
               MsgBox "Error nº.: " & lngRet & ", ao enviar email." & vbCr & vbCr & "MAPI32.DLL, não é a versão correta.", vbCritical, "ERRO"
         Case Else
              MsgBox "Erro ao enviar email: " & lngRet, vbCritical, "ERRO"
   End Select
End Function

 

lngRet = SendMail("Arquivo", "teste@mail.com.br", "", "", "caminho", "TEXTO DA MENSAGEM")