envoi d'une feuille

[PHILIP]

Bonjour à tous,

j'ai des relevés a envoyé automatiquement toutes les fins de semaine et qui font partis du même classeur Pour ce faire j'aimerai envoyé independament feuille par feuille et là j'ai un probleme car ma macro expedie le classeur complet , pourriez vous m'aider? (les feuilles ont pour nom partenaire geny et actua, le classeur global_s1)

Sub Courrier()

Dim Cdo_Message As Object
Dim strBody As String
Set Cdo_Message = CreateObject("CDO.Message")
Const CdoTo = 1
Const CdoCc = 2
Const CdoBcc = 3
strBody = "Bonjour" & vbNewLine & vbNewLine & _
              "Veuillez trouver-ci joint le relevé des interims de la semaine derniere" & vbNewLine & vbNewLine & _
              "Cordialement" & vbNewLine & vbNewLine & _
              "Philippe Lohr" & vbNewLine & _
              "Wincanton Mondia"
              
       Set Cdo_Message.Configuration = GetSMTPServerConfig() 'Appelle la Function
        With Cdo_Message
            .To = "philippe.lohr" & Chr(64) & "wincanton.fr" '"a507" & Chr(64) & "adia.fr" 'Récupère la variable du destinataire
            .From = "philippe.lohr" & Chr(64) & "wincanton.fr" 'Mettre addresse e-mail
            .Subject = "Wincanton delivery  " '& """" & Sheets("globale").Cells(r, 2) & """" & Sheets("globale").Cells(r, 8) & """" & Sheets("globale").Cells(r, 13) 'Récupère le sujet
            .TextBody = strBody 'Récupère le corps du message
            .AddAttachment ("T:\INTERIM_2011\Global_S1.sheets("ADIA").xlsx)
            .CC = "philippe.lohr" & Chr(64) & "wincanton.fr"
            .Send
        End With
    'End If
'Next
Set Cdo_Message = Nothing

Call choix

End Sub
 
Function GetSMTPServerConfig() As Object
' Microsoft CDO for Windows 2000 Library
    Const cdoSendUsingPickup = 1
    Const cdoSendUsingPort = 2
    Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
    Const cdoSendUsername = "http://schemas.microsoft.com/cdo/configuration/sendusername"
    Const cdosendpassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
    Const cdosendsmtpauthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
    Dim Cdo_Config As Object 'New CDO.Configuration
    Set Cdo_Config = CreateObject("CDO.Configuration")
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields
 
    With Cdo_Fields
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        .Item(cdoSMTPServer) = "GLSC01.premium-logistics.com" 'Adapter l'adresse SMTP (voir Outlook)
        .Item(cdoSMTPServerPort) = 25
        .Item(cdoSMTPAuthenticate) = 2
        .Item(cdoSendUsername) = "girauldlogistics/plohr"
        .Item(cdosendpassword) = "HR9073EE"
        
        .Update
    End With
 
    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing
 
End Function

 

[MJ13]

Re : envoi d'une feuille

Bonjour Philip

Il sufit que tu copies ta feuille, que tu l'enregistres, que tu l'envoies puis, si tu veux, tu peux la supprimer .

Pas de nouvelles, bonne nouvelle .