GuillaumA
XLDnaute Occasionnel
Bonjour. CI-joint la macro COMPLÈTE de mon envoi de mail par Excel.
Cette dernière crée des pièces jointes des feuilles du classeur Excel en .xls
Cette macro marche parfaitement en 2003 (, FileFormat:=56 en moins) et marche a 99% en 2007 (crée les feuilles en .xls, les reconnaît et peu les tuer en fin de macro à travers: Kill NomDesClasseurs(i)
Cependant, à chaque fois, j'ai un echec d'envoi, cela n'arrive pas à atteindre le serveur. La méthode CDO fonctionne-t'elle sous 2007 ? Car je ne verrai que ça comme problème vu qu'apparement le CDO marche parfaitement en 2003 pour la même macro.
Cordialement,
Guillaume
LA MACRO:
J'utilise la librairie: CDO for Windows 2000
Cette dernière crée des pièces jointes des feuilles du classeur Excel en .xls
Cette macro marche parfaitement en 2003 (, FileFormat:=56 en moins) et marche a 99% en 2007 (crée les feuilles en .xls, les reconnaît et peu les tuer en fin de macro à travers: Kill NomDesClasseurs(i)
Cependant, à chaque fois, j'ai un echec d'envoi, cela n'arrive pas à atteindre le serveur. La méthode CDO fonctionne-t'elle sous 2007 ? Car je ne verrai que ça comme problème vu qu'apparement le CDO marche parfaitement en 2003 pour la même macro.
Cordialement,
Guillaume
LA MACRO:
J'utilise la librairie: CDO for Windows 2000
Code:
'Part 1 - Creation of Workbook corresponding to attached files
Sub EnvoyerMail()
Dim i As Integer
Dim NomDeLaFeuille As String
Dim NomDesClasseurs(1 To 11)
Dim ZonePJ As Range
Dim ZoneD As Range
Dim ZoneCC As Range
Set ZonePJ = Range("C19:C29")
Dim chemin As String
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
Dim debutnom As String
debutnom = Range("C38")
Answer = MsgBox(Range("C39"), vbYesNo)
If Answer = vbYes Then
For i = 19 To 29
If Not IsEmpty(Range("C" & i)) Then
NomDeLaFeuille = Range("C" & i)
NomDesClasseurs(i - 19 + 1) = chemin & "\" & debutnom & NomDeLaFeuille & ".xls"
Sheets(NomDeLaFeuille).Visible = True
ThisWorkbook.Sheets(NomDeLaFeuille).Copy
ActiveWorkbook.SaveAs (chemin & "\" & debutnom & NomDeLaFeuille), FileFormat:=56
ActiveWorkbook.Close
Sheets(NomDeLaFeuille).Visible = False
End If
Next i
Call SendMailCDO(NomDesClasseurs)
For i = 1 To 11
If NomDesClasseurs(i) <> "" Then Kill NomDesClasseurs(i)
Next
ZonePJ.ClearContents
End If
End Sub
Code:
'Part 2 - What is going to be sent
Sub SendMailCDO(NomDesClasseurs)
Dim D As String
Dim CC As String
Dim E As String
Dim S As String
Dim T As String
On Error GoTo SMTPSendMail_Err
D = Range("C34").Value
CC = Range("C36").Value
E = Range("C16").Value
S = Range("C4").Value
T = Range("C7").Value & Chr(10) & Chr(10) & Range("C10").Value & Range("C16").Value
Dim Cdo_Message As New CDO.Message
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
.To = D 'Receivers
.CC = CC 'CC
.From = E 'Sender
.Subject = S 'Mail title
.TextBody = T 'Mail text
For i = 1 To 11
If NomDesClasseurs(i) <> "" Then .AddAttachment NomDesClasseurs(i) 'Attached files
Next
.send
End With
success = MsgBox(Range("C42"), vbInformation)
Exit Sub
'Errors management
SMTPSendMail_Err:
tmp = MsgBox(Range("C43") & Chr(10) & Range("C44") & Err.Description, vbCritical)
End Sub
Code:
'Part 3 - Server and users informations
Function GetSMTPServerConfig() As Object
Dim Cdo_Config As New CDO.Configuration
Dim Cdo_Fields As Object
Set Cdo_Fields = Cdo_Config.Fields
With Cdo_Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "smtp.gmail.com"
.Item(cdoSMTPServerPort) = 465
.Item(cdoSendUserName) = Range("C16").Value 'User name of the user
.Item(cdoSendPassword) = InputBox(Range("C41")) 'Gmail password of the user
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSMTPUseSSL) = True
.Update
End With
Set GetSMTPServerConfig = Cdo_Config
Set Cdo_Config = Nothing
Set Cdo_Fields = Nothing
End Function
Dernière édition: