Créer un hyperlien en fin d'opération de macro d'export

Out of category
1

Bonjour,

est-ce possible d'avoir l'adresse du répertoire d'export en hyperlien dans un Userform d'une macro VBA.

Je souhaite utiliser ma macro d'export PDF DXF STEP ZIP, ... et qu'à la fin de opération, en plus d'avoir le message "opération terminée avec succès", je souhaite avoir soit un lien hypertexte vers ce répertoire, soit un bouton permettant d'y accèder.

Le summum serait même d'avoir un bouton "Envoyer par mail" qui ouvrirai un nouveau message avec un sujet et contenu prédéfini et y joindre le document exporté. C'est pour mes demandes qui reviennent assez souvent. Merci de votre aide.

2

Cela pourra peut -être te donner une piste en remplaçant internet explorer par l'explorateur windows:

https://forum.solidworks.com/thread/207477

 

3

J'ai réussi.

J'ai fini par faire un UserForm et la macro remplace un champ Texte par le nom du fichier ou l'adresse du répertoire. J'ai utilisé les paramètres _Click du userform pour Ouvrir en style hyperlien (j'ai fait un changement de mise en forme de la souris par le style "main") lorsqu'on survole le champ texte, et j'ai mis un bouton pour accéder au répertoire : 

Private Sub LabelFileExport_Click()
On Error GoTo OuvertureFichierErreur
   Dim MonApplication As Object
   Dim MonFichier As String
   Set MonApplication = CreateObject("Shell.Application")
   
   MonFichier = vDestinationPath & "\" & sRefName & ".zip"
   MonApplication.Open (MonFichier)
   
   Set MonApplication = Nothing
Exit Sub

OuvertureFichierErreur:
   Set MonApplication = Nothing
    MsgBox "Erreur lors de l'ouverture de fichier..."

End Sub

Private Sub CommandButtonOpenPath_Click()
Shell Environ("WINDIR") & "\explorer.exe " & vDestinationPath, vbNormalFocus
End Sub

 

Pour l'envoi d'un mail avec la pièce jointe, j'ai trouvé réponse par morceaux sur plusieurs forum et ca donne cela :

Private Sub CommandButtonSendMail_Click()
On Error GoTo EnvoyerEmailErreur
'définition des variables
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
Dim Body As Variant
Dim sTmp As String, SigString As String
Dim Signature As String
Dim strbody As String

PieceJointe = vDestinationPath & "\" & sRefName & ".zip"

    'préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)
    
    strbody = "<font size=3>" _
            & "Bonjour,<br>" _
            & "Pouvez-vous s'il vous plaît me faire votre meilleure offre de prix et délais pour la fourniture de l'élément en plan ci-joint.<br>" _
            & "Cordialement,"
    
    'création de l'email
    With oMailItem
        .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
        .Subject = "Demande de prix - " & sRefName
        .HTMLBody = strbody & .HTMLBody
        If PieceJointe <> "" Then .Attachments.Add PieceJointe
       '.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)
'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