vba et thunderbird

bbanor

XLDnaute Occasionnel
Bonjour à tous

une question qui me travaille depuis pas mal de temps : est il possible de créer une macro (qui serait copier dans différents classeur) qui enverrait le classeur par mail mais en utilisant thunderbird?

Je ne sais pas si je suis assez claire.

J'attends de vous lire

PS : en navigant sur le forum j'ai réussi à trouver ce code mais il ne fonctionne qu'avec outlook. Moi je voudrais qu'il utilise thunderbird:

Sub SortirUserForm()
Dim Msg As Byte
Msg = MsgBox("Etes-vous sûr de vouloir envoyer le classeur entier ? " & _
vbCrLf & " à : " & MailAdresse, vbYesNo + vbQuestion, "Thierry's Démo")
If Msg = 6 Then
Sheets(1).Range("A1") = MailAdresse
Sheets(1).Range("A2") = MailSubject
MailAdresse = ""
MailSubject = ""
Application.OnTime Now + TimeValue("00:00:01"), "SendWorkBook"
Else: MsgBox "Pas Glop Glop...", vbInformation, "Thierry's Démo LOL !"
End If
End Sub

'le ActiveWorkbook.SendMail (ou ThisWorkbook) depuis un UserForm plante la merde
'avec une error de path...C'est pour çà tout ce sbinz...

Sub SendWorkBook()
Dim Maille As String
Dim Sujet As String
Maille = Sheets(1).Range("A1")
Sujet = Sheets(1).Range("A2")

ThisWorkbook.SendMail Maille, Sujet
MsgBox "Votre classeur a bien été envoyé"
End Sub
 
Dernière édition:

nicomaiden

XLDnaute Nouveau
Re : vba et thunderbird

Hello,
Je viens de poster une question similaire. J'ai un code outlook qui marche très bien mais
je cherche le meme pour thunderbird.
J'ai fouillé partout et rien...
Donc si j'ai une réponse, je te tiens au courant.
++
 

nicomaiden

XLDnaute Nouveau
Re : vba et thunderbird

Avec thunderbird, ça ne fonctionne pas.
Par contre ce code là fonctionne, il faut juste adapter après.


Sub CDO_Mail_Small_Text()
Dim iMsg As Object
Dim iConf As Object



With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = x
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxx" 'à adapter
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = xx
.Update
End With

On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "L").Value) = "yes" _
And LCase(Cells(cell.Row, "M").Value) <> "send" Then
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = "xxxxx"
.from = "xxxxx"
.Subject = "Rappel"
.TextBody = "Bonjour," & vbNewLine & vbNewLine & Range("A")



.Send
End With



Set iMsg = Nothing
Cells(cell.Row, "M").Value = "send"
End If

Next cell


With Application
.EnableEvents = True
.ScreenUpdating = True
End With



cleanup:
Set iMsg = Nothing
Application.ScreenUpdating = True


End Sub

Voilà !
 

nicomaiden

XLDnaute Nouveau
Re : vba et thunderbird

Bonjour,
Je te joins mon code :


Sub CDO_Mail_Small_Text()

Dim iMsg As Object
Dim iConf As Object


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = X ' selon parametrage boite mail
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxx" ' selon parametrage boite mail
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = XX ' selon parametrage boite mail
.Update
End With

On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _ ' si une adresse mail est saisie en colonne b mais moi je saisie en dessous donc cette ligne ne sert pas
LCase(Cells(cell.Row, "L").Value) = "yes" _ ' si en colonne L t'as "yes"
And LCase(Cells(cell.Row, "M").Value) <> "send" And _ ' en M t'as envoyé (ça evite de l'envoyer à chaque fois"
LCase(Cells(cell.Row, "A").Select) And _ ' il copie la colonne A
LCase(Cells(cell.Row, "I").Select) And _ ' il copie la colonne I
LCase(Cells(cell.Row, "M").Select) Then ' il copie la colonne M

-> ça sert pour le corps du mail, il renvoie ces éléments



Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = "Adresse mail destinaire"
.from = "ton adresse mail"
.Subject = "Rappel"
.TextBody = "Bonjour," & vbNewLine & vbNewLine & _
"Le contrat suivant arrive à échéance :" & vbNewLine _
& "- " & Cells(cell.Row, "A").Value & " le " & Cells(cell.Row, "I").Value & " - Modalité de résiliation : " & Cells(cell.Row, "M").Value
.Send
End With


Set iMsg = Nothing
Cells(cell.Row, "M").Value = "send"
End If

Next cell


With Application
.EnableEvents = True
.ScreenUpdating = True
End With


cleanup:
Set iMsg = Nothing
Application.ScreenUpdating = True


End Sub

Avec ce code t'as un mail par contrat dépassé avec les infos contenues en colonne A, M et I.

voilà
 

bbanor

XLDnaute Occasionnel
Re : vba et thunderbird

Salut Nicomaiden

j'ai essayé ton code mais ça ne marche pas dans mon fichier. Je ne sais pas si je l'ai bien adapté à mon fichier.

Pourrais tu m'envoyer un fichier exemple afin de voir un peu plus clair s'il te plaît?

Merci d'avance et a te lire bientôt
 

nicomaiden

XLDnaute Nouveau
Re : vba et thunderbird

Voilà le code qui fonctionne dans ton cas.
Mets en A1 ton destinataire.
indique ton parametrage de serveur smpt.
Ajoutes un destinaaire;
et tout est ok

Sub CDO_Mail_Every_Worksheet_File()
'Working in 97-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim Sourcewb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim iMsg As Object
Dim iConf As Object
' Dim Flds As Variant


Set Sourcewb = ThisWorkbook
TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
'See examples for other formats below this macro
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.xxxxxxxx.com" 'selon parametrage mail
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With


For Each sh In Sourcewb.Worksheets
If sh.Range("A1").Value Like "?*@?*.?*" Then

sh.Copy
Set wb = ActiveWorkbook

'Change all cells in the worksheet to values if you want
With wb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False

TempFileName = "Sheet " & sh.Name & " of " _
& Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With

Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = sh.Range("a1").Value
.From = "xxxxxxxxxxx" 'ton adresse mail
.Subject = "Sheet: " & sh.Name
.AddAttachment TempFilePath & TempFileName & FileExtStr
.TextBody = "Hi there"
.Send
End With
Set iMsg = Nothing

Kill TempFilePath & TempFileName & FileExtStr

End If
Next sh

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 675
Messages
2 090 799
Membres
104 668
dernier inscrit
Mac-Breheny