XL 2013 Insérer lien hypertexte cliquable dans mail envoyé par VBA

Claggan

XLDnaute Nouveau
Bonjour,

J'ai un fichier avec un formulaire qui me permet de sélectionner une adresse email dans une liste et d'envoyer un mail au destinataire.

J'ai besoin que le destinataire puisse accéder au fichier source de l'envoi du mail, depuis un lien hypertexte cliquable dans le corps du mail.

J'ai récupéré le code suivant que j'ai intégré à un module :
VB:
Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String)

On Error GoTo EnvoyerEmailErreur

'définition des variables
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
Dim Body As Variant

Body = ContenuEmail

    'vérification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoyé. Si vous voulez pouvoir envoyer les email vides, mettez en commentaire les 4 lignes de code qui suivent.
    If (Body = False) Then
        MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"
        Exit Sub
       End If
    
    'préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)
    
    'création de l'email
    With oMailItem
        .To = Destinataire
        .Subject = Sujet
        
        'CHOIX DU FORMAT
        '----------------------
        'email formaté comme texte
            .BodyFormat = olFormatRichText
            .Body = Body
            
            'OU
            
        'email formaté comme HTML
            '.BodyFormat = olFormatHTML
            '.HTMLBody = "<html><p>" & Body & "</p></html>"
        '----------------------
        
        If PieceJointe <> "" Then .Attachments.Add PieceJointe

       .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
       .Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
       .Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
    End With
    
   'nettoyage...
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
    
   Exit Sub

EnvoyerEmailErreur:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
 
    MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub

Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )

'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------

On Error Resume Next
    'vérification si Outlook est ouvert
    Set oOutlook = GetObject(, "Outlook.Application")
    
    If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        
        If (Err.Number <> 0) Then
            MsgBox "Une erreur est survenue lors de l'ouverture de Outlook..."
            Exit Sub
        Else
        End If
        
    Else    'si Outlook est ouvert, l'instance existante est utilisée
    End If

End Sub

Et le code suivant intégré dans le bouton d'envoi du formulaire :
Code:
Dim MonSujet As String
    Dim MonDestinataire As String
    Dim MonContenu As String
    Dim MaPieceJointe As String
        MonSujet = "DAA - Message automatique - Ajout par " & TextBox2.Value & " d'une ligne qui vous concerne dans le fichier DAA"
        MonDestinataire = ComboBox6.Value
        MonContenu = "Bonjour " & ComboBox6.Value & "," & vbCrLf & vbCrLf & "Un problème nécessitant une amélioration a été remonté par " & TextBox2.Value & "." & vbCrLf & vbCrLf & "Ajouté le " & Format(Now(), "dd/mm/yyyy à hh:mm") & ", il concerne l'atelier " & ComboBox1.Value & " et le problème est le suivant : " & TextBox3.Value & "." & vbCrLf & vbCrLf & "Veuillez valider ou refuser cette ligne." & vbCrLf & "Cliquez sur le lien ci-après pour accéder au fichier." & vbCrLf & "Ce message a été généré automatiquement, merci de ne pas y répondre."
        MaPieceJointe = "G:\INFO\5 . Amélioration continue\4 . Demandes amélioration atelier\DAA.xlsm"
            Call EnvoyerEmail(MonSujet, MonDestinataire, MonContenu, MaPieceJointe)

Aujourd'hui l'envoi par pièce-jointe ne convient pas car elle crée une copie du fichier et non un lien direct, la personne ne peut dont pas modifier le même fichier que son expéditeur.

Auriez-vous des pistes ?

Merci d'avance !

Cordialement
 

Discussions similaires

Réponses
3
Affichages
277
Réponses
0
Affichages
115
Haut Bas