Envoi mail avec une pièce jointe avec emplacements différents (serveur)

Le 23/06/2021 à 08:57

Bonjour à tous,
Petite question pour un débutant dans le monde VBA.

Voici un petit code, permettant d'envoyer un mail outlook avec pièce jointe à partir d'un bouton d'une feuille excel. Cette feuille excel sera accessible à un groupe d'utilisateurs.

Mon problème vient du fait que la pièce jointe, stocké sur le serveur de ma boite, n'est pas situé sur le même chemin pour tous les utilisateurs. En effet, la façon dont est monté le serveur de l'entreprise n'est pas la même selon les utilisateurs. De cette manière, le chemin d'accès au fichier diffère. (bon, il n'y a que 2 issues possibles).

Mon idée était définir ces 2 chemins, puis faire appel à un Error GoTo dans le cas où un chemin n'est pas trouvé.

Si je fais cela (code surement mal écrit), le mail Outlook va bien sé générer mais j'aurai tout de même le MsgBox "Le mail n'a pas pu être envoyé" de l'autre situation.

Comment faire les choses proprement / ne pas afficher le MsgBox ?

Private Sub CommandButton2_Click()

Dim MonSujet As String
Dim MonContenu As String
Dim MaPieceJointe1 As String
Dim MaPieceJointe2 As String

MaPieceJointe1 = "chemin1\fichier.xlsx"
MaPieceJointe2 = "chemin2\fichier.xlsx"

MonSujet = "Sujet"
MonContenu = "Bonjour, <br> <br>" & _
             "L'équipe"

On Error GoTo Suite1
 Call EnvoyerEmail(MonSujet, MonContenu, MaPieceJointe1)
Suite1:
 Call EnvoyerEmail(MonSujet, MonContenu, MaPieceJointe2)

End Sub

Si besoin, la fonction EnvoyerEmail (trouvé sur la toile, irréfutable à priori).

Sub EnvoyerEmail(ByVal Sujet 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 WasOutlookOpen As Boolean
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)

'------------------------------------------------------------------------------------------------
'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 GoTo PreparerOutlookErreur

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")
    Else    'si Outlook est ouvert, l'instance existante est utilisée
        Set oOutlook = GetObject("Outlook.Application")
        oOutlook.Visible = True
    End If
    Exit Sub

PreparerOutlookErreur:
    MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub
Le 24/06/2021 à 09:06

Bonjour,

Pouvez-vous essayer en utilisant la fonction Dir() :

Private Sub CommandButton2_Click()

Dim MonSujet As String
Dim MonContenu As String
Dim MaPJ As String, Rep as string

Rep = SpecificPath("chemin1", "chemin2") 'chemins par variable ou en dur sans antislash de fin
MaPJ = Rep & "\fichier.xlsx"

MonSujet = "Sujet"
MonContenu = "Bonjour, <br> <br>" & _
             "L'équipe"
Call EnvoyerEmail(MonSujet, MonContenu, MaPJ)

End Sub

function SpecificPath(Path1$, Path2$) as string
on error resume next
select case true
    case dir(Path1) <> "": SpecificPath = Path1
    case dir(Path2) <> "": SpecificPath = Path2
end select
end function

Cdlt,

Rechercher des sujets similaires à "envoi mail piece jointe emplacements differents serveur"