1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
Option Compare Database
Option Explicit
'Déclarations speciales pour MAPI
Type MAPIMESSAGE
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
flags As Long
RecipCount As Long
FileCount As Long
End Type
Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
Type MapiFile
Reserved As Long
flags As Long
position As Long
PathName As String
FileName As String
FileType As String
End Type
Global Dialogue As MAPIMESSAGE
Declare Function MAPISendMail _
Lib "MAPI32.DLL" _
Alias "BMAPISendMail" (ByVal Session&, _
ByVal UIParam&, _
Message As MAPIMESSAGE, _
Recipient() As MapiRecip, _
File() As MapiFile, _
ByVal flags&, _
ByVal Reserved&) As Long
Global Const SUCCESS_SUCCESS = 0
Global Const MAPI_TO = 1
Global Const MAPI_CC = 2
Global Const MAPI_CCO = 3
Global Const MAPI_LOGON_UI = &H1
Global Const MAPI_DIALOG = &H8
Function CountWords(ByVal sSource As String, _
ByVal sDelim As String)
Dim iDelimPos As Integer
Dim iCount As Integer
If sSource = "" Then
CountWords = 0
Else
iDelimPos = InStr(1, sSource, sDelim)
Do Until iDelimPos = 0
iCount = iCount + 1
iDelimPos = InStr(iDelimPos + 1, sSource, sDelim)
Loop
CountWords = iCount + _
IIf(right(sSource, 1) = sDelim, 0, 1)
End If
End Function
Function GetWords(sSource As String, _
ByVal sDelim As String) As String
Dim iDelimPos As Integer
iDelimPos = InStr(1, sSource, sDelim)
If (iDelimPos = 0) Then
GetWords = Trim$(sSource)
sSource = ""
Else
GetWords = Trim$(left$(sSource, iDelimPos - 1))
sSource = Mid$(sSource, iDelimPos + 1)
End If
End Function
Sub ParseWords(mArray() As String, _
ByVal sTokens As String, _
ByVal sDelim As String)
Dim i As Integer
For i = LBound(mArray) To UBound(mArray)
mArray(i) = GetWords(sTokens, sDelim)
Next i
End Sub
Function SendMail(sSubject As String, sMessage As String, Optional sTo As String, Optional sAttach As String) As Long
Dim i As Integer
Dim cto As Integer
Dim cAttach As Integer
Dim MAPI_Message As MAPIMESSAGE
If Len(sTo) > 0 Then
cto = CountWords(sTo, ";")
ReDim rTo(0 To cto) As String
ParseWords rTo(), sTo, ";"
ReDim MAPI_Recip(0 To cto - 1) As MapiRecip
For i = 0 To cto - 1
MAPI_Recip(i).Name = rTo(i)
MAPI_Recip(i).RecipClass = MAPI_TO
Next i
End If
If Len(cAttach) > 0 Then
cAttach = CountWords(sAttach, ";")
ReDim rAttach(0 To cAttach) As String
ParseWords rAttach(), sAttach, ";"
ReDim MAPI_File(0 To cAttach) As MapiFile
MAPI_Message.FileCount = cAttach
For i = 0 To cAttach - 1
MAPI_File(i).position = -1
MAPI_File(i).PathName = rAttach(i)
Next i
End If
MAPI_Message.Subject = sSubject
MAPI_Message.NoteText = sMessage
MAPI_Message.RecipCount = cto
Dialogue.flags = MAPI_LOGON_UI + MAPI_DIALOG
SendMail = MAPISendMail(0&, 0&, MAPI_Message, MAPI_Recip(), MAPI_File(), Dialogue.flags, 0)
End Function |
Envoyer des mails avec CDO
Répondre avec citation
Partager