Lancer outlook avec macro excel 2007
Fermé
bruiz
Messages postés
123
Date d'inscription
dimanche 23 mars 2008
Statut
Membre
Dernière intervention
10 octobre 2022
-
6 mars 2012 à 15:08
eljojo_e Messages postés 1155 Date d'inscription lundi 10 mai 2010 Statut Membre Dernière intervention 14 octobre 2022 - 14 mars 2012 à 15:17
eljojo_e Messages postés 1155 Date d'inscription lundi 10 mai 2010 Statut Membre Dernière intervention 14 octobre 2022 - 14 mars 2012 à 15:17
A voir également:
- Lancer outlook avec macro excel 2007
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Save as pdf office 2007 - Télécharger - Bureautique
- Si et excel - Guide
- Aller à la ligne excel - Guide
1 réponse
eljojo_e
Messages postés
1155
Date d'inscription
lundi 10 mai 2010
Statut
Membre
Dernière intervention
14 octobre 2022
153
Modifié par eljojo_e le 14/03/2012 à 15:17
Modifié par eljojo_e le 14/03/2012 à 15:17
Bonjour,
J'ai fait un code pour lancer une messagerie thunderbird avec une/plusieurs pièce jointe, tu peut t'en inspirer :
Sub CmdPEmail()
dossier = Sheets("Configuration").Range("e2").Value ' par défaut C:\Program Files\Mozilla Thunderbird
dossier2 = Len(Dir(dossier, vbDirectory))
If dossier2 <> 0 Then
Else
MsgBox ("La messagerie 'Mozilla Thunderbird' n'a pas été trouvé dans" & vbLf & vbLf & dossier)
GoTo a:
End If
Dim dlgOpen As FileDialog
Dim FichierSélectionné As Variant
'joindre un/plusieurs fichier(s)
Select Case MsgBox("Joindre des fichiers au mail ???", vbInformation + vbYesNo, "Joindre fichiers")
Case vbYes
azf = ""
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
'.InitialFileName = tr 'pour répertoire racine par exemple
.Show
.Title = "Joindre un/des fichiers au mail"
For Each FichierSélectionné In .SelectedItems
If FichierSélectionné <> "" Then azf = azf & "," & FichierSélectionné
Next
End With
If IsNull(azf) Or azf = "" Then
Else
azf = Right(azf, Len(azf) - 1)
End If
Case vbNo
End Select
Set OuvrirFichier = Nothing
Set dlgOpen = Nothing
Call remplacer
Sujet = Sheets("Mailing").Range("b4").Value
Msg = Sheets("Mailing").Range("b6").Value
Dim a, b
b = ""
For a = 4 To 188
If Sheets("Mailing").Range("m" & a).Value <> "" Then
b = b & Sheets("Mailing").Range("m" & a).Value & ","
Else
If b = "" Then Exit Sub
End If
Next
qui = "'" & b & "'"
toto = dossier & "\thunderbird -compose attachment=" & "'" & azf & "'" & ",body=" & Msg & ",subject=" & Sujet & ",to=" & qui ''C:\temp\info.doc,C:\temp\food.doc'
Call Shell(toto)
a:
ActiveWorkbook.Saved = True
End Sub
J'ai aussi intégrer le remplacement des virgules car thunderbird n'aime pas les virgules :
Sub remplacer()
Sheets("Mailing").Range("B6:J34").Select
Cells.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
(Le mieu si tu veu pas te prendre la tête c'est d'installer thunderbird et ce code fonctionne très bien)
Je peut t'envoyer le fichier excel complet si tu veut,
Cordialement,
J'ai fait un code pour lancer une messagerie thunderbird avec une/plusieurs pièce jointe, tu peut t'en inspirer :
Sub CmdPEmail()
dossier = Sheets("Configuration").Range("e2").Value ' par défaut C:\Program Files\Mozilla Thunderbird
dossier2 = Len(Dir(dossier, vbDirectory))
If dossier2 <> 0 Then
Else
MsgBox ("La messagerie 'Mozilla Thunderbird' n'a pas été trouvé dans" & vbLf & vbLf & dossier)
GoTo a:
End If
Dim dlgOpen As FileDialog
Dim FichierSélectionné As Variant
'joindre un/plusieurs fichier(s)
Select Case MsgBox("Joindre des fichiers au mail ???", vbInformation + vbYesNo, "Joindre fichiers")
Case vbYes
azf = ""
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
'.InitialFileName = tr 'pour répertoire racine par exemple
.Show
.Title = "Joindre un/des fichiers au mail"
For Each FichierSélectionné In .SelectedItems
If FichierSélectionné <> "" Then azf = azf & "," & FichierSélectionné
Next
End With
If IsNull(azf) Or azf = "" Then
Else
azf = Right(azf, Len(azf) - 1)
End If
Case vbNo
End Select
Set OuvrirFichier = Nothing
Set dlgOpen = Nothing
Call remplacer
Sujet = Sheets("Mailing").Range("b4").Value
Msg = Sheets("Mailing").Range("b6").Value
Dim a, b
b = ""
For a = 4 To 188
If Sheets("Mailing").Range("m" & a).Value <> "" Then
b = b & Sheets("Mailing").Range("m" & a).Value & ","
Else
If b = "" Then Exit Sub
End If
Next
qui = "'" & b & "'"
toto = dossier & "\thunderbird -compose attachment=" & "'" & azf & "'" & ",body=" & Msg & ",subject=" & Sujet & ",to=" & qui ''C:\temp\info.doc,C:\temp\food.doc'
Call Shell(toto)
a:
ActiveWorkbook.Saved = True
End Sub
J'ai aussi intégrer le remplacement des virgules car thunderbird n'aime pas les virgules :
Sub remplacer()
Sheets("Mailing").Range("B6:J34").Select
Cells.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
(Le mieu si tu veu pas te prendre la tête c'est d'installer thunderbird et ce code fonctionne très bien)
Je peut t'envoyer le fichier excel complet si tu veut,
Cordialement,