Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetWorkingFolder() As String
GetWorkingFolder = WorkingFolder
End Function
Public Sub sendMail(Recipient As String, message As String, tabFiles() As String)
Dim objSession As Object
Dim objMessage As Object
Dim objRecipient As Object
Dim objAttachments As Object
Dim lpBuff As String * 1024
Dim Login As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Recipient = "" Then
MsgBox ("Impossible d'envoyer le mail !")
Exit Sub
End If
GetUserName lpBuff, Len(lpBuff)
Login = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
lpBuff = ""
Set objSession = CreateObject("mapi.session")
On Error Resume Next
objSession.Logon "", "", False, False
If Err.Number <> 0 Or objSession.CurrentUser = "Unknown" Then
Err.Clear
Set objSession = Nothing
Set objSession = CreateObject("mapi.session")
objSession.Logon profileName:=Login
If Err.Number <> 0 Or objSession.CurrentUser = "Unknown" Then
MsgBox ("Impossible d'envoyer le message. Ouvrir Outlook et essayer une nouvelle fois.")
Exit Sub
End If
End If
On Error GoTo 0
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = "Disponibilité du " & UserForm1.TextBox1.Value
objMessage.Text = message
' Add files as attachement
Set objAttachments = objMessage.Attachments
For i = LBound(tabFiles) To UBound(tabFiles)
If Not (IsNull(tabFiles(i)) Or tabFiles(i) = "") Then
' Test file exist
If fso.fileexists(tabFiles(i)) Then
' Add attachement
objAttachments.Add Right(tabFiles(i), Len(tabFiles(i)) - InStrRev(tabFiles(i), "\")), 0, , tabFiles(i)
End If
End If
Next
Set objRecipient = objMessage.Recipients.Add
objRecipient.Name = Recipient
objRecipient.Resolve
objMessage.Fields.Add &H59020003, 1
objMessage.Update
objMessage.Send showdialog:=False
objSession.Logoff
End Sub