17. Nous allons continuer avec la feuille F_EnvoiCourrier. Seulement une fonction et une procédure à placer dans cette feuille. Commençons par la fonction, celle qui réalise l'envoi du message.

Public Function Envoi_Courrier(Destinataire As String, Sujet As String, Texte As--> String) As Boolean
   On Error GoTo ErrHandler   'Capture d'erreur
   MAPISession1.SignOn   'Ouverture de la session MAPI
   MAPIMessages1.SessionID = MAPISession1.SessionID  'Initialisation de-->
   MAPIMessages
   With MAPIMessages1
      .Compose
      .RecipDisplayName = Destinataire  'Nom du destinataire
      .AddressResolveUI = True   'Indique si l'adresse a été trouvée
      .ResolveName
      .MsgSubject = Sujet   'Sujet du message
      .MsgNoteText = Texte    'Texte du message
      .Send   'Envoi de tous les éléments
   End With
   Envoi_Courrier = True   'Il n'y a pas eu d'erreur, donc l'envoi est réussi
   MAPISession1.SignOff   'Fermeture de la session
   Exit Function   'Sortie de la fonction
ErrHandler:  'Gestion d'erreur
   MsgBox err.Description   'Afficher la description de l'erreur
   Unload Me   'Décharger la feuille
   Envoi_Courrier = False   'Indique que l'envoi n'a pas été réussi
End Function

18. La procédure, quant à elle, est placée dans le bouton BO_Envoyer. Elle fait appel à la fonction Envoi_Courrier.

Private Sub BO_Envoyer_Click()
   Dim V_res As String   'Déclaration de variable
   V_res = Envoi_Courrier(ZT_Destinataire, ZT_Sujet, ZT_Message)  'Appel de ---:
   fonction
   If V_res = False Then  'Si le message n'a pu être envoyé
      MsgBox "Impossible d'envoyer le courriel."   'Message d'envoi raté
   Else   'Sinon
      MsgBox "Courriel envoyé."   'Message de réussite
   End If
   ZT_Destinataire.Text = ""  'Réinitialisation des zones de texte
   ZT_Sujet.Text = ""
   ZT_Message.Text = ""
   Unload Me   'Déchargement de  la feuille
End Sub

19. Il ne reste plus qu'une seule feuille secondaire à compléter, la feuille F_Ouvrir. Les scripts qu'elle contient ont tous déjà été vus au cours des exercices de base VisualBasic ou dans d'autre procédure de cette application. Les voici.

Private Sub BO_Ok_Click()
   F_Interface.Nav_1.Navigate Trim(ET_NomPage.Caption)   'Affiche la page dans-->
   le navigateur
   Unload Me   'Décharge  la feuille
End Sub


Private Sub Form_Load()
   LL_1.Drive = App.Path   'Spécifie le lecteur dont l'application est chargée
   LR_1.Path = App.Path    'Spécifie le répertoire dont l'application est chargée
End Sub

Sub LR_1_Change()   'Procédure Change et non Click
    LF_1.Path = LR_1.Path    'Met à jour la liste des fichiers en fonction du -->
    répertoire choisi
End Sub

Private Sub LF_1_Click()
   If Right(LF_1.Path, 1) <> "\" Then    ' La fonction RIGHT vérifie si
   'le nom du chemin d’accès est celui du répertoire racine ( \ ).
      ET_NomPage.Caption = LF_1.Path & "\" & LF_1.FileName  ' LF_1.Path -->
      renvoie le lecteur et le chemin d’accès du répertoire, "\"` ajoute un séparateur-->
      (barre oblique inverse) et LF_1.Filename renvoie le nom du fichier.
   Else
      ET_NomPage.Caption = LF_1.Path & LF_1.FileName  'Pas de barre oblique
   End If
End Sub

20. Passons maintenant à la feuille pricipale: MDI_Navigateur. Elle contient tout d'abord quelques procédures de base que voici.

Private Sub MDIForm_Activate()  'Lors de l'activation de la feuille
   F_Interface.Show   'Charge la feuille fille F_Interface
End Sub

Private Sub MDIForm_Load()   'Lors du chargement de la feuille
   If CheckInternetConnection Then   'Si la connection  est effectuée, on ne fait rien
   Else   'Sinon message d'erreur
      MsgBox "Connection internet non disponible. Reconnectez-vous et essayez-->
      à nouveau. ", vbInformation + vbMsgBoxRtlReading, "PAS DE CONNEXION!"
      End  'Fin du programme
   End If
End Sub

Private Sub MDIForm_Terminate()   'Lorsque l'application se termine
   On Error Resume Next   'En cas d'erreur, passer à l'instruction suivante
   Unload F_Interface   'Décharger F_Interface
   Unload Me   'Décharger MDI_Navigateur
   End   'Fin du programme
   err.Clear  'Vider les erreurs
   End   'Fin du programme
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)   'Lors du déchargement de la-->
feuille
   End  'Fin du programme
End Sub

21. Les autre procédures présentes dans cette feuille sont celles liées à la barre de menu. Vous les trouverez ci-dessous.

Private Sub Mn_Actualiser_Click()  'Actualiser
   F_Interface.Nav_1.Refresh2 0   'Appel de la fonction de rafraîchissement
End Sub

Private Sub Mn_AfficheFavoris_Click()  'Afficher les favoris
   V_Source = "Afficher"   'Initialiser V_source
   F_Favoris.Show   'Montrer la feuille
End Sub

Private Sub Mn_Ajout_Favori_Click()  'Ajouter un favori
   AjouteFavori   'Appel de la procédure AjouteFavori
End Sub

Private Sub Mn_Arrêt_Click()   'Arrêter
   F_Interface.Nav_1.Stop   'Appel de la fonction Stop
End Sub

Private Sub Mn_Chercher_Click()  'Recherche sur la toile du Québec
   F_Interface.Nav_1.Navigate "http:\\www.toile.qc.ca"   'Ouverture de la page
End Sub

Private Sub Mn_Démarrage_Click()   'Accueil
   On Error GoTo err    'Capture d'erreur
   F_Interface.Nav_1.GoHome   'Appel de la fonction GoHome
err:
  err.Clear   'Vider les erreurs
End Sub

Private Sub Mn_Désélection_Click()   'Désélectionner
   F_Interface.Nav_1.ExecWB OLECMDID_CLEARSELECTION,  -->
   OLECMDEXECOPT_DODEFAULT  'Procédure de désélection
End Sub

Private Sub Mn_EffaceFavori_Click()  'Effacer un favori
   V_Source = "Effacer"   'Initialiser V_source
   F_Favoris.Show   'Montrer la feuille
End Sub

Private Sub Mn_Enregistrer_Click()   'Enregistrer
   On Error Resume Next  'Capture d'erreur
    F_Interface.Nav_1.ExecWB OLECMDID_SAVEAS,-->
    OLECMDEXECOPT_PROMPTUSER, 0, 0  'Procédure d'enregistrement
err.Clear
End Sub

Private Sub Mn_Fermer_Click()   'Quitter
   Sortie   'Appel de la procédure de sortie
End Sub

Private Sub Mn_Imprimer_Click()  'Imprimer
   On Error Resume Next   'Capture d'erreur
   F_Interface.Nav_1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER  
   'Procédure d'impression
   err.Clear  'Vide la variable Err
End Sub 

Private Sub Mn_InitFavori_Click()  'Réinitialiser les favoris
   Dim V_Fichier As String   'Déclaration de variable
   On Error GoTo vide   'Capture d'erreur
   V_Fichier = App.Path & "\Favoris.txt"  'Initialisation de V_Fichier
   Open V_Fichier For Output As #1   'Ouverture du fichier
   Close #1  'Fermeture du fichier
   vide:   'Sortie en cas d'erreur
End Sub

Private Sub Mn_Intégré_Click()   'Envoi d'un courriel
   F_EnvoiCourriel.Show   'Affichage de la fenêtre
End Sub

Private Sub Mn_Ip_Click()  'Adresse IP
   Dim V_Ip As String   'Déclaration de variable
   V_Ip = F_Interface.Winsock1.LocalIP    'Identification de l'adresse IP
   F_Interface.ZT_Informations.Text = "Adresse IP: " & V_Ip  'Affichage de l'adresse
End Sub

Private Sub Mn_Kilo_Click()   'Taille en kilo-octets
   Dim V_Koctets 'Déclaration de variable
   F_Interface.Inet1.OpenURL F_Interface.CO_1.Text 'Identification de la page
   V_Koctets = Val(F_Interface.Inet1.GetHeader("Content-length")) / 1024 'Calcul-->
   de la taille en Ko
   V_Koctets = Round(V_Koctets)   'Réponse arrondie
   F_Interface.ZT_Informations.Text = "Taille de la page: " & V_Koctets & " Kilo-->
   -octets "   'Affichage de la réponse
End Sub

Private Sub Mn_Liens_Click()  'Liste des liens
   Affiche_Liens   'Appel de la procédure
End Sub

Private Sub Mn_Octets_Click()  'Taille en octets
   F_Interface.Inet1.OpenURL F_Interface.CO_1.Text  'Identification de la page
   F_Interface.ZT_Informations.Text = "Taille de la page: " & -->
   F_Interface.Inet1.GetHeader("Content-length") & " octets "  'Identification et-->
   affichage de la taille
End Sub

Private Sub Mn_Outlook_Click()   'Chargement de OutLook Express
   Shell "C:\Program Files\Outlook Express\MSIMN.EXE", vbNormalFocus
End Sub

Private Sub Mn_Ouvrir_Click()   'Ouvrir une page
   F_Ouvrir.Show   'Affichage de la feuille
End Sub

Private Sub Mn_Précédent_Click()   'Page précédente
   On Error GoTo err   'Capture d'erreur
   F_Interface.Nav_1.GoBack   'Appel de la fonction GoBack
err:
   err.Clear  'Vide la variable Err
End Sub

Private Sub Mn_Propos_Click()  'Fenêtre À propos
   F_Propos.Show 'Affichage de la feuille
End Sub

Private Sub Mn_Propriétés_Click()  'Propriétés
   Shell ("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0")  'Affiche la fenêtre
End Sub

Private Sub Mn_Recherche_Click()  'Recherche dans la page
   On Error Resume Next   'Capture d'erreur
   F_Interface.Nav_1.SetFocus  'Donne le focus au navigateur
   SendKeys "^f", True   'Envoie la commande CTRL + F
End Sub

Private Sub Mn_Serveur_Click()  'Serveur
   Dim V_PageWeb As String   'Initialisation de variable
   V_PageWeb = Trim(F_Interface.CO_1.Text) 'Extraction des espaces au début-->
    et à la fin de l'adresse
   strHTML = F_Interface.Inet1.OpenURL(V_PageWeb)   'Identification de la page
   strServer = F_Interface.Inet1.GetHeader("Server")   'Identification du serveur
   F_Interface.ZT_Informations.Text = "Serveur: " & strServer  'Affichage du serveur
End Sub

Private Sub Mn_Source_Click()  'Source
   F_Html.Show  'Affichage de la feuille
End Sub

Private Sub Mn_Copier_Click()  'Copier
   F_Interface.Nav_1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER
End Sub

Private Sub Mn_Couper_Click()  'Couper
   F_Interface.Nav_1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER
End Sub

Private Sub Mn_Coller_Click()  'Coller
   F_Interface.Nav_1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_PROMPTUSER
End Sub

Private Sub Mn_Suivant_Click()  'Page suivante
   On Error GoTo err
   F_Interface.Nav_1.GoForward   'Appel de la fonction GoForward
err:
   err.Clear   'Vide la variable Err
End Sub

Private Sub Mn_Tout_Click()  'Tout sélectionner
   F_Interface.Nav_1.SetFocus   'Donne le focus au navigateur
   F_Interface.Nav_1.ExecWB OLECMDID_SELECTALL, -->
   OLECMDEXECOPT_PROMPTUSER  'Sélectionne tout
End Sub

22. Vous avez sans doute remarqué que de nombreuses procédures ont la même syntaxe: F_Interface.Nav_1.ExecWB OLECMDID_SELECTALL, 
    OLECMDEXECOPT_PROMPTUSER. La seule chose qui change est la fonction désirée: SELECTALL, CUT, COPY, PASTE. Dans le cas de CLEARSELECTION, on remplace PROMPTUSER par DODEFAULT. Dans le cas de SAVEAS, on ajoute aussi deux paramètre à la fin: ,0,0.

Suite...