OUTLOOK MAIL(SUJET ET MESSAGE) / OUVRIR UNE PAGE NET (VÉRIFICATION DE LA CONNEXION)

' ============================
' On déclare deux API pour pouvoir lancer
' INTERNET  ou envoyer un  MAIL .
' ============================

Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpclassname As Any, _
     ByVal lpCaption As Any) As Long

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
     ByVal lpOperation As String, _
     ByVal lpFile As String, _
     ByVal lpParameters As String, _
     ByVal lpDirectory As String, _
     ByVal nShowCmd As Long) As Long


' ================================
' On déclare une API pour tester la connexion.
' ================================

Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
    (ByRef lpSFlags As Long, _
     ByVal lpszConnexionName As String, _
     ByVal dwNameLen As Long, _
     ByVal dwReserved As Long) As Long


' ==================
' INTERNET (MAIL et SITES)
' ==================


Sub PourTester()

dim Connexion as boolean

Connexion = ramNET("mailto:ram-bc@club.fr", "Mail pour essayer", "Un petit message pour ne pas laisser.")

Connexion = ramNET("http://www.club-internet.fr/")

End Sub

Function ramNET(Adresse As String, _
        Optional SujetDuMessagePourUnMailUniquement As String, _
        Optional TexteDuMessagePourUnMailUniquement As String) As Boolean

' *****************************************************
' Le code ci-dessous a été rédigé à l'aide de deux codes.
' La partie pour envoyer un mail de façon "complète" avec
' sujet et message se trouve sur le site  vbfrance.com                   
' à l'adresse :  "http://www.vbfrance.com/code.aspx?ID=30302" .
' La partie permettant de tester la connexion Internet est à
' "http://docvb.free.fr/codedetail.php?idc=114&p=0|6|17|21|119|" .
' *****************************************************
' "mailto:ram-bc@club.fr"  pour un mail.
' "http://www.club-internet.fr/"  pour une page web.
'
' Cette fonction utilise les deux API
' apiFindWindow (pour rechercher Outlook
' et le lanceur Internet)  et  ShellExecute
' (pour ouvrir Outlook ou Internet), ainsi
' que  InternetGetConnectedStateEx  (pour
' tester si la connexion est établie).
'
' IMPORTANT !!! La déclaration des API doit toujours
' se faire en début de module.


' =================================
' La valeur  hwnd  "localise" Outlook ou Internet.
' =================================
Dim hwnd As Long


' ============================
' Si l'adresse correspond à celle d'un mail,
' on ouvre Outlook même si la connexion
' n'est pas établie (ceci permet d'écrire
' un mail hors connexion).
' ============================
If InStr(1, Adresse, "mailto:") <> 1 Then
        ' On n'a pas une adresse de mail.
    If InternetGetConnectedStateEx(0, Space$(256), 0, 0&) = False Then
        ' La connexion n'est pas établie.
        MsgBox "Impossible d'ouvrir la page Internet car la connexion n'est pas établie"
        ramNET = False
        Exit Function
    End If
End If

hwnd = apiFindWindow("OPUSAPP", "0")


If InStr(1, Adresse, "mailto:") <> 1 Then
        ' On n'a pas une adresse de mail.
    ShellExecute hwnd, "open", Adresse, "", "C:\", SW_SHOWNORMAL
        ' Pour lancer directement la page
        ' sans tester une fausse adresse.
Else
        ' On a une adresse de mail.
    Call ShellExecute(hwnd, "open", _
            Adresse + "?Subject=" + _
            SujetDuMessagePourUnMailUniquement + _
            "&body=" + TexteDuMessagePourUnMailUniquement + _
            "", 0&, 0&, 1)
End If

ramNET = True

End Function

06 mai 2005 14:09:54 :

Correction des "fôtes" d'orthographe.