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.