Macro email piece jointe

Bonjour tous le monde,

J'utilise cette macro pour rédiger un nouvel email qui me propose de selectionner 1 ou plusieurs pièce jointe.

    Sub envoiemailpiecejointe()
        Dim ObjOutlook As New Outlook.Application
        Dim oBjMail
        Dim Nom_Fichier

        Set ObjOutlook = New Outlook.Application
        Set oBjMail = ObjOutlook.CreateItem(olMailItem)

        ChDir "G:\Dropbox\Dropbox N\FABIO"
        Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
        If Not IsArray(Nom_Fichier) Then Exit Sub
        sigstring = Environ("appdata") & _
                    "\Microsoft\Signatures\"
        f = Dir(sigstring & "*.htm")    'on prend la première signature trouvée
      If f <> "" Then
            Signature = GetBoiler(sigstring & f)
            Signature = Replace(Signature, "src=""", "src=""" & sigstring)
        Else
            Signature = "pas de signature trouvée"
        End If

        On Error Resume Next

        With oBjMail
            .Display    ' Ici on peut supprimer pour l'envoyer sans vérification
          .To = "test@test.fr"    ' le destinataire
          '.BCC = "" 'adresse destinataires pour info
          .Subject = "Objet du mail"    ' l'objet du mail
          .HTMLBody = "Ecrire email" & "<br>" & Signature   'le corps du mail et la signature
          .BodyFormat = olFormatHTML    'signature outlook
          For i = 1 To UBound(Nom_Fichier)
                .Attachments.Add Nom_Fichier(i)    '"C:\Data\essai.txt" ' ou Nomfichier
          Next
        End With
        Set oBjMail = Nothing
        Set ObjOutlook = Nothing

    End Sub

    Function GetBoiler(ByVal sFile As String) As String
    'Dick Kusleika
      Dim fso As Object
        Dim ts As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
        GetBoiler = ts.readall
        ts.Close
    End Function

Lorsque je clique dessus, j'ai cette erreur :

ERREUR DE COMPILATION

Type defini par l'utilisateur non defini

Dim ObjOutlook As New Outlook.Application CETTE LIGNE SE MET EN BLEU

sur 1 classeur elle fonctionne super, sur un autre classeur pas du tout !!

quelqu'un aurais une idée svp?

merciiiiii

bonjour,

il manque probablement la référence à outlook.

dans l'éditeur VBA, aller à outils,références, checker outlook

Bonsoir,

Reference est en grisé

Pour info, j'ai une macro qui me permet d'ouvrir excel et cela fonctionne.

Sub ouvreoutlook()

Shell "OUTLOOK.EXE", 3

End Sub

Bonsoir,

pour avoir accès aux références, toutes les macros doivent être arrêtées.

alternative pour ne pas avoir à mettre les références, le "late binding", voici le code adapté

Sub envoiemailpiecejointe()
        Dim ObjOutlook As Object
        Dim oBjMail
        Dim Nom_Fichier
        OlMailItem = 0
        Set ObjOutlook = CreateObject("Outlook.Application")
        Set oBjMail = ObjOutlook.CreateItem(OlMailItem)

        ChDir "G:\Dropbox\Dropbox N\FABIO"
        Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
        If Not IsArray(Nom_Fichier) Then Exit Sub
        sigstring = Environ("appdata") & _
                    "\Microsoft\Signatures\"
        f = Dir(sigstring & "*.htm")    'on prend la première signature trouvée
     If f <> "" Then
            Signature = GetBoiler(sigstring & f)
            Signature = Replace(Signature, "src=""", "src=""" & sigstring)
        Else
            Signature = "pas de signature trouvée"
        End If

        On Error Resume Next

        With oBjMail
            .Display    ' Ici on peut supprimer pour l'envoyer sans vérification
         .To = "test@test.fr"    ' le destinataire
         '.BCC = "" 'adresse destinataires pour info
         .Subject = "Objet du mail"    ' l'objet du mail
         .HTMLBody = "Ecrire email" & "<br>" & Signature   'le corps du mail et la signature
         .BodyFormat = olFormatHTML    'signature outlook
         For i = 1 To UBound(Nom_Fichier)
                .Attachments.Add Nom_Fichier(i)    '"C:\Data\essai.txt" ' ou Nomfichier
         Next
        End With
        Set oBjMail = Nothing
        Set ObjOutlook = Nothing

    End Sub

Parfait merci pour cette réponse, ca fonctionne super merciiii beaucoup.

Rechercher des sujets similaires à "macro email piece jointe"