---Soumis par Dev Ashish---
Envoyer un E-mail en utilisant CDO/Outlook 98.
Avec une référence active à la nouvelle bibliothèque (library) CDO disponible avec Outlook 98, on peut maintenant envoyer du courrier électronique depuis Access 97.
Voici un module de classe qui automatise le tout pour vous. Ne pas oublier de demander la référence (menu: tools, References... ) à Microsoft CDO 1.21, puis, couper-coller le code dans un module de classe.
Télécharger MAPIStuff.Zip (50,488 bytes). Access 97.
'**************** Usage Example Start **************** Sub TestMAPIEmail() Dim clMAPI As clsMAPI Set clMAPI = New clsMAPIEmail With clMAPI .MAPILogon .MAPIAddMessage .MAPISetMessageBody = "Test Message" .MAPISetMessageSubject = "Some Test" .MAPIAddRecipient stPerson:="dash10@hotmail.com", _ intAddressType:=1 'To .MAPIAddRecipient stPerson:="Dev Ashish", _ intAddressType:=2 'cc .MAPIAddRecipient stPerson:="smtp:dash10@hotmail.com", _ intAddressType:=3 'bcc .MAPIAddAttachment "C:\temp\Readme.doc", "Jet Readme" .MAPIAddAttachment stFile:="C:\config.sys" .MAPIUpdateMessage .MAPISendMessage boolSaveCopy:=False .MAPILogoff End With End Sub '**************** Usage Example End **************** '**************** Class Start *********************** ' Option Compare Database Option Explicit Private mobjSession As MAPI.Session Private mobjMessage As Message Private mboolErr As Boolean Private mstStatus As String Private mobjNewMessage As Message Private Const mcERR_DOH = vbObjectError + 10000 Private Const mcERR_DECIMAL = 261144 'low word order +1000 Public Sub MAPIAddMessage() With mobjSession Set mobjNewMessage = .Outbox.Messages.Add End With End Sub Public Sub MAPIUpdateMessage() mobjNewMessage.Update End Sub Private Sub Class_Initialize() mboolErr = False End Sub Private Sub Class_Terminate() On Error Resume Next Set mobjMessage = Nothing mobjSession.Logoff Set mobjSession = Nothing End Sub Public Property Let MAPISetMessageBody(stBodyText As String) If Len(stBodyText) > 0 Then mobjNewMessage.Text = stBodyText End Property Public Property Let MAPISetMessageSubject(stSubject As String) If Len(stSubject) > 0 Then mobjNewMessage.Subject = stSubject End Property Public Property Get MAPIIsError() As Boolean MAPIIsError = mboolErr End Property Public Property Get MAPIRecipientCount() As Integer MAPIRecipientCount = mobjNewMessage.Recipients.Count End Property Public Sub MAPIAddAttachment(stFile As String, _ Optional stLabel As Variant) Dim objAttachment As Attachment Dim stMsg As String On Error GoTo Error_MAPIAddAttachment If mboolErr Then Err.Raise mcERR_DOH If Len(Dir(stFile)) = 0 Then Err.Raise mcERR_DOH + 10 mstStatus = SysCmd(acSysCmdSetStatus, "Adding Attachments...") If IsMissing(stLabel) Then stLabel = CStr(stFile) With mobjNewMessage .Text = " " & mobjNewMessage.Text Set objAttachment = .Attachments.Add With objAttachment .Position = 0 .Name = stLabel 'no need to link a file me thinks .Type = CdoFileData .ReadFromFile stFile End With .Update End With Exit_MAPIAddAttachment: Set objAttachment = Nothing Exit Sub Error_MAPIAddAttachment: mboolErr = True If Err = mcERR_DOH + 10 Then stMsg = "Couldn't locate the file " & vbCrLf stMsg = stMsg & "'" & stFile & "'." & vbCrLf stMsg = stMsg & "Please check the file name and path and try again." MsgBox stMsg, vbExclamation + vbOKOnly, "File Not Found" ElseIf Err <> mcERR_DOH Then MsgBox "Error " & Err.Number & vbCrLf & Err.Description End If Resume Exit_MAPIAddAttachment End Sub Public Sub MAPIAddRecipient(stPerson As String, intAddressType As Integer) Dim objNewRecipient As Recipient 'local On Error GoTo Error_MAPIAddRecipient mstStatus = SysCmd(acSysCmdSetStatus, "Adding Recipients...") If mboolErr Then Err.Raise mcERR_DOH 'If there's no SMTP present in the stPerson var, then 'we have to use Name, else Address With mobjNewMessage If InStr(1, stPerson, "SMTP:") > 0 Then Set objNewRecipient = .Recipients.Add(Address:=stPerson, _ Type:=intAddressType) Else Set objNewRecipient = .Recipients.Add(Name:=stPerson, _ Type:=intAddressType) End If objNewRecipient.Resolve End With Exit_MAPIAddRecipient: Set objNewRecipient = Nothing Exit Sub Error_MAPIAddRecipient: mboolErr = True Resume Exit_MAPIAddRecipient End Sub Public Sub MAPISendMessage(Optional boolSaveCopy As Variant, _ Optional boolShowDialog As Variant) mstStatus = SysCmd(acSysCmdSetStatus, "Sending message...") If IsMissing(boolSaveCopy) Then boolSaveCopy = True End If If IsMissing(boolShowDialog) Then boolShowDialog = False End If mobjNewMessage.Send savecopy:=boolSaveCopy, showdialog:=boolShowDialog End Sub Public Sub MAPILogon() On Error GoTo err_sMAPILogon Const cERROR_USERCANCEL = -2147221229 mstStatus = SysCmd(acSysCmdSetStatus, "Login....") Set mobjSession = CreateObject("MAPI.Session") mobjSession.Logon exit_sMAPILogon: Exit Sub err_sMAPILogon: mboolErr = True If Err = CdoE_LOGON_FAILED - mcERR_DECIMAL Then MsgBox "Logon Failed", vbCritical + vbOKOnly, "Error" ElseIf Err = cERROR_USERCANCEL Then MsgBox "Aborting since you pressed cancel.", _ vbOKOnly + vbInformation, "Operatoin Cancelled!" Else MsgBox "Error number " & Err - mcERR_DECIMAL & " description. " _ & Error$(Err) End If Resume exit_sMAPILogon End Sub Public Sub MAPILogoff() On Error GoTo err_sMAPILogoff mstStatus = SysCmd(acSysCmdSetStatus, "Logging off...") mobjSession.Logoff Set mobjNewMessage = Nothing Set mobjSession = Nothing mstStatus = SysCmd(acSysCmdClearStatus) exit_sMAPILogoff: Exit Sub err_sMAPILogoff: Resume exit_sMAPILogoff End Sub '**************** Class End ***********************