Envoi mail vb 2005 api windows

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 800 fois - Téléchargée 20 fois

Contenu du snippet

Cette Classe permet L'envoi d'e-mail quelque soit votre client de messagerie par défaut elle utilise MAPI. Elle est la modification d'une classe déjà sur code Source end VB6.
Fonctionne avec Vista.

Source / Exemple :


Imports System.Runtime.InteropServices

Public Class MailingClass

    Public Enum Mail_Software
        DefaultMailSoftware
        Smtp
    End Enum

    Private Function Isnull(ByVal Source As Object, ByVal ReplaceBy As Object) As Object
        If Source Is System.DBNull.Value Then
            Return ReplaceBy
        Else
            If Source Is Nothing Then
                Return ReplaceBy
            Else
                Return Source
            End If
        End If
    End Function

    '----------------------------------------------------------------------------------------------------------'
    '               déclaration des types utilisés
    '----------------------------------------------------------------------------------------------------------'
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure Message
        Dim Reserved As Integer
        Dim Subject As String
        Dim NoteText As String
        Dim MessageType As String
        Dim DateReceived As String
        Dim ConversationID As String
        Dim flags As Integer
        Dim RecipCount As Integer
        Dim FileCount As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure Recip
        Public Reserved As Integer
        Public RecipClass As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public Name As String
        <MarshalAs(UnmanagedType.LPTStr)> Public Address As String
        Public EIDSize As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public EntryID As String
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
      Structure File
        Public Reserved As Integer
        Public flags As Integer
        Public POSITION As Integer
        <MarshalAs(UnmanagedType.LPTStr)> Public PathName As String
        <MarshalAs(UnmanagedType.LPTStr)> Public FileName As String
        <MarshalAs(UnmanagedType.LPTStr)> Public FileType As String
    End Structure

    Private zlParentHwnd, zlSessionID, zlShowDialogs As Integer
    Private Const MAPI_DIALOG As Short = &H8S
    Private Const MAPI_LOGON_UI As Short = &H1S
    Private Const MAPI_TO As Short = 1
    Private Const MAPI_CC As Short = 2
    Private Const MAPI_CCO As Short = 3

    Private Declare Function GetActiveWindow Lib "user32" () As Integer

    Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal lUIParam As Integer, ByVal user As String, ByVal Password As String, ByVal lFlags As Integer, ByVal lReserved As Integer, ByRef lSession As Integer) As Integer

    Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal lSession As Integer, ByVal lUIParam As Integer, ByVal lFlags As Integer, ByVal lReserved As Integer) As Integer

    Private Declare Function MAPISendMailOE Lib "C:\Program Files\Outlook Express\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPISendMailWM Lib "C:\Program Files\Windows Mail\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer
    'Private Declare Function MAPISendMailWM Lib "C:\msoe.dll" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Private Declare Function MAPILogon12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" (ByVal lUIParam As Integer, ByVal user As String, ByVal Password As String, ByVal lFlags As Integer, ByVal lReserved As Integer, ByRef lSession As Integer) As Integer

    Private Declare Function MAPILogoff12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" (ByVal lSession As Integer, ByVal lUIParam As Integer, ByVal lFlags As Integer, ByVal lReserved As Integer) As Integer

    Private Declare Function MAPISendMailO12 Lib "C:\Program Files\Microsoft Office\Office12\OLMAPI32.DLL" Alias "BMAPISendMail" (ByVal session As Integer, ByVal UIParam As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef Message As Message, <MarshalAs(UnmanagedType.SafeArray)> ByRef Recipient() As Recip, <MarshalAs(UnmanagedType.SafeArray)> ByRef File() As File, ByVal flags As Integer, ByVal Reserved As Integer) As Integer

    Public Function SendMail(ByVal MailTo As String, ByVal Subject As String, Optional ByVal Body As String = Nothing, Optional ByVal Attachments() As String = Nothing, Optional ByVal MailFrom As String = Nothing, Optional ByVal Host As String = Nothing, Optional ByVal DirectSend As Boolean = False, Optional ByVal CC As String = Nothing, Optional ByVal CCO As String = Nothing, Optional ByVal MailingMethod As Mail_Software = Mail_Software.DefaultMailSoftware) As Boolean

        'Controle de l'adresse
        If MailTo = Nothing Then
            Throw New Exception("Adresse destinataire non définie")
            Return False
        End If

        If MailTo.LastIndexOf("@") = -1 Or MailTo.LastIndexOf(".") = -1 Then
            Throw New Exception("Adresse Destinataire Mal orthographiée")
            Return False
        End If

        Dim DefaultSoft As String = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Clients\Mail\", False).GetValue("")

        If MailingMethod = Mail_Software.Smtp Then DefaultSoft = "Smtp"

        Dim X As Integer
        Dim MAPI_Message As Message = Nothing
        Dim Nto As Integer = CountWords(MailTo, ";")
        Dim NCC As Integer = CountWords(CC, ";")
        Dim NCCO As Integer = CountWords(CCO, ";")
        Dim MAPI_recip(Nto + NCC + NCCO - 1) As Recip
        Dim MAPI_file(Attachments.Length - 1) As File
        Dim Dialog As Integer = 1

        Select Case DefaultSoft
            Case "Outlook Express", "Microsoft Outlook", "Microsoft Office Outlook", "Outlook", "Windows Mail"
                If Not DirectSend Then Dialog = 9
                MAPI_Message.Subject = Subject
                MAPI_Message.NoteText = Isnull(Body, "")

                MAPI_Message.RecipCount = MAPI_recip.Length

                For X = 0 To Nto - 1
                    MAPI_recip(X).Name = Isnull(MailTo, "").Split(";")(X)
                    MAPI_recip(X).RecipClass = MAPI_TO
                Next

                For X = 0 To NCC - 1
                    MAPI_recip(Nto + X).Name = Isnull(CC, "").Split(";")(X)
                    MAPI_recip(Nto + X).RecipClass = MAPI_CC
                Next

                For X = 0 To NCCO - 1
                    MAPI_recip(Nto + NCC + X).Name = Isnull(CC, "").Split(";")(X)
                    MAPI_recip(Nto + NCC + X).RecipClass = MAPI_CCO
                Next

                MAPI_Message.FileCount = MAPI_file.Length
                For X = 0 To Attachments.Length - 1
                    MAPI_file(X).POSITION = -1
                    MAPI_file(X).PathName = Attachments(X)
                Next
            Case Else
                DefaultSoft = "Smtp"
        End Select

        Try
            Select Case DefaultSoft
                Case "Outlook Express"

                    SendMail = MAPISendMailOE(0, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                Case "Microsoft Outlook", "Outlook", "Microsoft Office Outlook"

                    Logon("Outlook", "")

                    SendMail = MAPISendMail(zlSessionID, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                    LogOff()
                    'Case 

                    'Logon12("Outlook", "")

                    'SendMail = MAPISendMailO12(zlSessionID, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                    'LogOff12()

                Case "Windows Mail"

                    SendMail = MAPISendMailWM(0, 0, MAPI_Message, MAPI_recip, MAPI_file, Dialog, 0)

                Case "Smtp"
                    If MailFrom.LastIndexOf("@") = -1 Or MailFrom.LastIndexOf(".") = -1 Then
                        Throw New Exception("Adresse Expéditeur Mal orthographiée, ou non renseigné" + vbCrLf + "Vous pouvez la définir pour chaque utilisateur dans Administration - Les Renseignements utilisateur")
                        Return False
                    End If
                    Dim Mail As New System.Net.Mail.MailMessage
                    Mail.To.Add(MailTo)
                    Mail.From = New System.Net.Mail.MailAddress(MailFrom)
                    Mail.Subject = Subject
                    Mail.Body = Body
                    If Not Attachments Is Nothing Then
                        For X = 0 To Attachments.Length - 1
                            Mail.Attachments.Add(New System.Net.Mail.Attachment(Attachments(X)))
                        Next
                    End If

                    Try
                        Dim Smtp As New System.Net.Mail.SmtpClient(Host)
                        Smtp.Send(Mail)
                    Catch
                        Throw New Exception("L'hôte SMTP n'a pas été défini, vous pouvez le faire dans Administration - Paramètres Généraux")
                    End Try
            End Select
        Catch ex As Exception
            Throw ex
        End Try
        Return True

    End Function

    Private Function CountWords(ByVal st As String, ByVal Ch As Char) As Integer
        If st = Nothing Then Return 0
        st = st.Trim
        If st.LastIndexOf(Ch) = st.Length - 1 Then st = st.Remove(st.Length - 1, 1)
        Return st.Split(Ch).Length
    End Function

    '----------------------------------------------------------------------------------------------------------'
    '               je sais plus
    '----------------------------------------------------------------------------------------------------------'
    Private Sub Class_Initialize_Renamed()
        zlShowDialogs = MAPI_DIALOG
        zlParentHwnd = GetActiveWindow 'Seed parent window handle
    End Sub

    '----------------------------------------------------------------------------------------------------------'
    '               Connection au compte MAPI Outlook (pas Express)
    '----------------------------------------------------------------------------------------------------------'
    Private Sub Logon(Optional ByRef zsusername As String = Nothing, Optional ByRef zspassword As String = "")
        ' renvoit 0 si ok
        Dim lReturnValue As Integer

        If zsusername = Nothing Then
            zsusername = "Outlook"
            zspassword = ""
        End If

        Class_Initialize_Renamed()
        Try
            If zlSessionID Then
                'End existing session
                LogOff()
                zlSessionID = 0
            End If
            zlSessionID = 0
            lReturnValue = MAPILogon(zlParentHwnd, zsusername, zspassword, MAPI_LOGON_UI, 0, zlSessionID)
        Catch ex As Exception

        End Try
    End Sub

    Private Sub Logon12(Optional ByRef zsusername As String = Nothing, Optional ByRef zspassword As String = "")
        ' renvoit 0 si ok
        Dim lReturnValue As Integer

        If zsusername = Nothing Then
            zsusername = "Outlook"
            zspassword = ""
        End If

        Class_Initialize_Renamed()
        Try
            If zlSessionID Then
                'End existing session
                LogOff()
                zlSessionID = 0
            End If
            zlSessionID = 0
            lReturnValue = MAPILogon12(zlParentHwnd, zsusername, zspassword, MAPI_LOGON_UI, 0, zlSessionID)
        Catch ex As Exception

        End Try
    End Sub

    '----------------------------------------------------------------------------------------------------------'
    '               Deconnection du compte
    '----------------------------------------------------------------------------------------------------------'
    Private Function LogOff() As Integer 'retourne 0 si ok
        If zlSessionID Then
            Return MAPILogoff(zlSessionID, zlParentHwnd, 0, 0)
            zlSessionID = 0
        End If
    End Function

    Private Function LogOff12() As Integer 'retourne 0 si ok
        If zlSessionID Then
            Return MAPILogoff12(zlSessionID, zlParentHwnd, 0, 0)
            zlSessionID = 0
        End If
    End Function

End Class

A voir également

Ajouter un commentaire

Commentaires

Hackman informaticien
Messages postés
13
Date d'inscription
jeudi 7 décembre 2006
Statut
Membre
Dernière intervention
12 mars 2008
-
Bonjour a toi Philippo
je suis débutant en vb.net. comment fait on pour utilisé la classe
je sais c'est pathétique d'être si nul...

merci d'avance
cs_PHILIPPO
Messages postés
6
Date d'inscription
mardi 24 juin 2003
Statut
Membre
Dernière intervention
1 décembre 2009
-
Salut sinon il y a plus simple si tu débute cette classe permet de ne pas inscrire les composant Mapi à ton projet sinon tu peu utiliser le controle activeX Microsoft MAPI Controls 6.0 à tes références et faire une fonction

Shared Function SendMail(ByVal MailTo As String, ByVal Subject As String, Optional ByVal Body As String Nothing, Optional ByVal Attachments() As String Nothing, Optional ByVal DirectSend As Boolean = False) As Boolean
Cursor.Current = Cursors.WaitCursor
Dim m As New MSMAPI.MAPIMessages
Dim s As New MSMAPI.MAPISession
s.SignOn()
m.SessionID = s.SessionID
m.Compose()
m.MsgIndex = -1
If MailTo = Nothing Then
Try
m.Show()
Catch ex As Exception
Cursor.Current = Cursors.Default
PolyMessage(ex.Message)
s.SignOff()
Return False
End Try

If m.RecipAddress Nothing Then m.RecipAddress m.RecipDisplayName
Else
m.RecipAddress = MailTo
m.RecipDisplayName = MailTo
End If
m.MsgSubject = Subject
If m.MsgSubject = Nothing Then
m.MsgSubject = "Mail"
End If
m.MsgNoteText = Body
If m.MsgNoteText = Nothing Then
m.MsgNoteText = "Mail"
End If

Dim d As Integer
For d = 0 To Attachments.Length - 1
m.AttachmentIndex = d
m.AttachmentPathName = Attachments(d)
Next

Try
If DirectSend Then
m.Send()
Else
m.Send(True)
End If
Catch ex As Exception
Cursor.Current = Cursors.Default
PolyMessage(ex.Message)
s.SignOff()
Return False
End Try
s.SignOff()
Return True
Cursor.Current = Cursors.Default
End Function
gillardg
Messages postés
3288
Date d'inscription
jeudi 3 avril 2008
Statut
Membre
Dernière intervention
14 septembre 2014
3 -
bonjour ,
j'utilise Windows Live Mail avec un compte Hotmail
et ça fonctionne pas ou alors c'est moi qui n'ai pas compris
et pour la seconde solution que tu proposes
activeX Microsoft MAPI Controls 6.0
j'ai pas trouvé sur ma bécane
cs_dbigeard
Messages postés
1
Date d'inscription
dimanche 12 décembre 2004
Statut
Membre
Dernière intervention
29 décembre 2008
-
Bonjour,
normal que tu n'ais pas trouvé
cet OCX est délivrée avec VB
de plus, elle est soumise à un control de licence
de ce fait, même si elle marche sur un PC de dev, il y a de fortes chances (déjà testé) qu'elle ne soit pas sur d'autres PC, sauf à l'installer.
Comme tu as pu le constater, elle ne fait pas partie de l'OS
cdt,
renocmoa
Messages postés
138
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
10 mai 2012
-
Bonjour,

Un peu tard peut être pour intervenir, mais on sait jamais... En effet beaucoup de pb avec MSMAPI d'un poste à l'autre...

Alors comment faire pour ouvrir un mail avec le client par défaut et avec une piéce jointe ?? Ca parait simple comme ça

Si quelqu'un à une idée (même avec dll payante !!)


Merci

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.