Envoie mail par liens Hypertexte VBA

Bonjour à tous ,

Je suis bloqué sur un point. Je travaille sur un fichier permettant d’actualiser des fichiers présent sur un disque réseaux en ressortant les liens hypertextes des fichiers présent sur ce disque. Maintenant je souhaiterai pouvoir cliquer sur un lien hypertexte d’un fichier et que ce dernier se mette en pièce jointe d’un mail, et ce si pour chaque lien présent.

Après des heures de recherches, je n’arrive pas à faire marcher quelques chose.

Merci de votre aide !

Sub SendMailData()

Dim Fichier As String
Dim MonOutlook As Object
Dim MonMessage As Object
Dim MyBench As String

 Chemin = "C:\xxxx\xxxxx\xxxx\"

MyBench = Sheets("Poste xxxxx").Range("B2").Value

  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.CreateItem(0)
  MonMessage.BodyFormat = 2
       Corps = "<HTML><BODY>"
         MonMessage.To = "mxxxx@xxxxx.com"
  MonMessage.CC = ""
'  MonMessage.Attachments.Add
  MonMessage.Subject = "'intervention pour"
  ' Le corps du message est divisé en 2 lignes :
 Corps = Corps & "Bonjour,"
  ' <p> = Touche ENTER
 Corps = Corps & "<p>"
   Corps = Corps & "<p> 'intervention pour : " & MyBench & ".</p>"
  Corps = Corps & "<p><a href=""C:\xxxx\xxxx\Dxxx"">Lien vers le document</a></p>"
  Corps = Corps & "</BODY></HTML>"
  MonMessage.HTMLBody = Corps
  MonMessage.Display

  Set MonOutlook = Nothing

End Sub

Voici ma base mais je n'arrive pas à pouvoir faire bouger le nom des cellules "My Bench" et le chemin des liens vers les documents

bonjour,

pour pouvoir t'aider, merci de mettre un classeur exemple représentatif de tes données (anonymisé si nécessaire), avec les explications concrètes sur base de ces données.

Bonsoir, merci de votre réponse.

Voici mon fichier en pièces jointes :

bonsoir,

C'est sûr que le classeur fourni aide à se faire une idée de la façon dont sont organisées les données.

Cependant voici une proposition.

Bonjour, une partie fonctionne mais je n'arrive pas à faire fonctionner le code qui permet d'attacher le fichier désiré en pièce jointe.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Fichier As String
    Dim MonOutlook As Object
    Dim MonMessage As Object
    Dim MyBench As String

    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.CreateItem(0)

     MyBench = Target.Value

     Dim Chemin As String
    Dim Dossier As String
    Dim SousDos As String
    ' Chemin initial
    Chemin = "C:\Users\xxxxx\xxxx\xxxxx\xxxxxxxxxx"
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    ' Sous-dossier selon le nom de l'onglet
    SousDos = MyBench
    If Right(SousDos, 1) <> "\" Then SousDos = SousDos & "\"
    ' Dossier à scanner
    Chemin = Chemin & SousDos

    MonMessage.BodyFormat = 2
    Corps = "<HTML><BODY>"
    MonMessage.To = "XXXX@XXXXXX.com"
    MonMessage.CC = ""
   'MonMessage.Attachments.Add 
    MonMessage.Attachments.Add MyBench
    MonMessage.Subject = "Procédure d'intervention pour " & MyBench & ""
    ' Le corps du message est divisé en 2 lignes :
    Corps = Corps & "Bonjour,"
    ' <p> = Touche ENTER
    Corps = Corps & "<p>"
    Corps = Corps & "<p> Ci-joint la demande d'intervention pour : " & MyBench & ""
    Corps = Corps & "<p><a href= Chemin >Lien vers le document</a></p>"
    Corps = Corps & "</BODY></HTML>"
    MonMessage.HTMLBody = Corps
    MonMessage.Display

    Set MonOutlook = Nothing

End Sub

J'ai essayé ça afin de pouvoir localiser les fichiers désirés mais rien n'y fais.

Merci à vous et bonne journée.

rebonjour,

cette version-ci fonctionne chez moi comme j'ai compris (deviné) qu'elle devait fonctionner.

Rechercher des sujets similaires à "envoie mail liens hypertexte vba"