Lien hypertexte dans mail envoyé en VBA

[Airone784]

Bonjour à tous,

Ci-joint mon code VB qui me pose problème :

Bonjour,

Private Sub CommandButton1_Click()

Dim message As String
    Dim Adr As String ' Adresse
    Dim Objet As String ' L'objet du message
    Dim Texte, Corps As String ' le texte du message
    Dim ligne As Integer
    Dim macell As Range

            Texte = "Bonjour," & vbCrLf & vbCrLf & "Une nouvelle action vous concerne. Vous pouvez consulter cette action sur le fichier suivant :"

            'Envoi aux adresses mail mis dans la zone
            Range("M7").Activate
            Do Until ActiveCell = ""
            If Lmail = "" Then
            Lmail = Range("M7")
            Else
            Lmail = Lmail & ";" & ActiveCell
            End If
            ActiveCell.Offset(1, 0).Activate
            Loop
          
            Adr = Lmail
            Objet = "Changement de statut de la problématique n° " & Range("A1")
            Corps = Texte
          

Dim mMessage As Object
Dim mConfig As Object
Dim mChps
  
    Set mConfig = CreateObject("CDO.Configuration")
  
    mConfig.Load -1
    Set mChps = mConfig.Fields
    With mChps
  
        'Si votre serveur demande une connexion sûre (SSL)
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        'Vous pouvez essayer sans ces trois lignes
        'Mais si votre serveur demande une authentification,
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxx@yahoo.fr"
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxx"

        'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hotmail "smtp.live.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.yahoo.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'En principe, 25 fonctionne avec tout les serveurs.
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2
        .Update
    End With
  
    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = Adr
        .From = "monadresse@yahoo.fr"
        .Subject = Objet
        .TextBody = Texte  
        .Send
    End With
    Set mMessage = Nothing
  
    'Libère les ressources
    Set mConfig = Nothing
    Set mChps = Nothing


End Sub

Avec ce bout de code, je voudrais pouvoir rajouter dans le texte de mon mail un lien hypertexte vers un fichier qui est sur un lecteur réseau partagé dont le raccourci est du genre \\monserveur\dossier_perso\fiche_activité.xlsm\

Seulement, je ne trouve pas de solution. Si quelqu'un sait comment faire, ce serait super.

Merci d'avance.

 

[Lone-wolf]

Bonjour Airone

Crée un variable type String (fichier par exemple). Ensuite: fichier = chemin du fichier reseau, et tu rajoute fichier dans Texte.

 

[Airone784]

Bonjour Airone

Crée un variable type String (fichier par exemple). Ensuite: fichier = chemin du fichier reseau, et tu rajoute fichier dans Texte.

Bonjour Lonewolf,

J'ai testé ce que tu me dis. Donc j'ai bien mon chemin \\nomduserveur\nomdudossier\nomsousdossier\nomdufichier\ qui apparaît dans le texte de mon mail mais à aucun moment je peux cliquer sur ce chemin pour ouvrir directement le dossier dans mon explorateur windows...

Dim fichier As String
fichier = "\\nomserveur\nomdossier\nomsousdossier\nomdufichier"

            Texte = "Bonjour," & vbCrLf & vbCrLf & _
            "Une nouvelle action vous concerne. Vous pouvez consulter cette action sur le fichier suivant :" & fichier

 

[Airone784]

Bonjour Lonewolf,

J'ai testé ce que tu me dis. Donc j'ai bien mon chemin \\nomduserveur\nomdudossier\nomsousdossier\nomdufichier\ qui apparaît dans le texte de mon mail mais à aucun moment je peux cliquer sur ce chemin pour ouvrir directement le dossier dans mon explorateur windows...

Dim fichier As String
fichier = "\\nomserveur\nomdossier\nomsousdossier\nomdufichier"

            Texte = "Bonjour," & vbCrLf & vbCrLf & _
            "Une nouvelle action vous concerne. Vous pouvez consulter cette action sur le fichier suivant :" & fichier

Voilà ce que je reçois dans mon mail :

 

[Lone-wolf]

Désolé pour l'oubli

Essaie en mettant le lien comme ceci: <a href='inserer le chemin d'accés >cliquez sur le lien</a>
Donc: Dim fichier As String
fichier = <a href='inserer le chemin d'accés >clique sur le lien</a>

sur le fichier suivant :" & fichier

 

[Airone784]

Désolé pour l'oubli

Essaie en mettant le lien comme ceci: <a href='inserer le chemin d'accés >cliquez sur le lien</a>
Donc: Dim fichier As String
fichier = <a href='inserer le chemin d'accés >clique sur le lien</a>

sur le fichier suivant :" & fichier

Re bonjour,

J'ai une erreur sur le code que tu proposes :

HTML et VBA seraient compatibles ???

 

[Lone-wolf]

Bonjour Airone

C'est peut-être le lien qui cause problème. Essaie en mettant l'adresse d'Excel-Downoad pour voir.

 

[mutzik]

bonjour,

cela ne changera pas la problématique, dim fichier as String => fichier = " ... "

essayer

"[URL="https://www.excel-downloads.com/"]http://www.excel-downloads.com[/URL]"

 

[Lone-wolf]

Re

Oubien comme ceci
Public Const Fichier As String = "<A HREF='https://www.excel-downloads.com/forums/forum-excel.7/ VBA</A>"

 

[mutzik]

voici un code qui fonctionne

Sub CreationMailEtLienHypertexte()
    Dim OlApp As New Outlook.Application
    Dim OlItem As Outlook.MailItem
    'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
   
    Set OlApp = New Outlook.Application
    Set OlItem = OlApp.CreateItem(olMailItem)
   
    With OlItem
        .To = "destinataire@dest.xx"
        .Subject = "Le titre du message"
        .Body = "Découvrez Microsoft Office sur le site Developpez" & _
            vbLf & "http://www.developpez.com" & vbLf & vbLf & _
            "Cordialement" & vbLf & "mailto:emetteur@mail.fr"
        .Display
        .Save
        .Send
    End With
   
    Set OlItem = Nothing
    Set OlApp = Nothing
End Sub

 

[Lone-wolf]

Re Bertrand

À moins qu'il ne modifie sa macro, l'envois par Outlook est obsolète vu qu'il passe par CDO

@ Airone: moi j'avais fait comme ceci dans un fichier. Dans un Module:

Public Const ParamSendUsing As String = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Public Const ParamServeur As String = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Public Const ParamPort As String = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Public Const ParamAutenticite As String = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Public Const ParamIdentifiant As String = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Public Const ParamMotDePasse As String = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Public Const ParamSsl As String = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
Public Const Fichier As String = "<A HREF='http://www.excel-downloads.com/forum/forum-excel/'>Excel VBA</A>"

Ensuite le reste du code.

 

[Lone-wolf]

Re Airone

J'ai retrouvé le fichier. En PJ

 

[mutzik]

Re

@Lone-wolf
erreur d'ouverture de ton fichier chez moi

1. sinon, faut-il activer une bibliothèque particulière pour utiliser CDO
2. as-tu un code complet qui fonctionne

Merci

 

[Lone-wolf]

Re Bertrand

Oui, il faut activer les références pour cdo et outlook. Je met la macro en ligne.

Sub EnvoiMailCDO()
Dim CdoMessage, CdoConfig, CdoParam
Dim Fichier As String
'Pour le serveur outlook.com
'smpt = smtp-mail.outlook.com
'Port = 25 (ou 587 si 25 est bloqué)
'Authentification:  oui
'Connexion chiffrée: TLS

'Pour GMail: smtp.gmail.com

    Fichier = ThisWorkbook.Path & "\Classeur1.xls"  'Si fichier se trouve dans le même dossier
    Set CdoConfig = CreateObject("CDO.Configuration")

    CdoConfig.Load -1
    Set CdoParam = CdoConfig.Fields

    With CdoParam
    .Item(ParamSendUsing) = 2
    .Item(ParamServeur) = "smtp.live.com"           ' < Ici Hotmail
    .Item(ParamPort) = 25
    .Item(ParamIdentificateur) = "1"
    .Item(ParamIdentifiant) = ""               'Votre Identifiant
    .Item(ParamMotDePasse) = ""                'Votre mot de passe
    .Item(ParamSsl) = "true"
    .Update
    End With

    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        Set .Configuration = CdoConfig
        .From = ""
        .To = ""
        .CC = "" 'destinataires en copie (CC)
        .BCC = "" 'destinataires en copie cachée (CCI)
        .Subject = "Test Mail CDO"
        .HTMLBody = "<HTML><body><p>Bonjour Messieurs,</p>" _
        & "<p>Veuillez prendre note du fichier en pièce jointe mis à jour.</p>" _
        & Lien & "<br></br>" _
        & "<br></br>Cordialement.<br></br><br></br>" _
        & "<p>Tom Tom</p></body><HTML>"
        '.AddAttachment (Fichier)
        .Send
    End With
    Set CdoMessage = Nothing
    Set CdoConfig = Nothing
    Set CdoParam = Nothing
End Sub

En image

 

[Airone784]

Bonjour à tous,

Merci pour vos coups de main. Mais j'ai peur qu'on s'égare quant à mon pb initial. Moi je veux créer un lien hypertexte vers un dossier partagé sur un serveur. Pour un lien vers une page web, je peux directement taper dans mon texte www.excel-downloads.com. Mon navigateur créera un lien vers ce site mais parce que le navigateur reconnait l'adresse comme une page web je pense.
En revanche, quand je tape un chemin d'accès à un dossier du type "\\nomduserveur\dossierpartagé\" par exemple , il ne se passe rien...
La balise href ne sert pas seulement pour des pages web ???