Envoi Classeur actif par internet

roby

XLDnaute Occasionnel
bonsoir le forum

apres plusieurs essais de code trouves sur ce forum, je cale car cela ne marche pas.

j'utilise incredimail comme messagerie.(si cela peut aider) car la plupart des codes utilisent outlook.
problème:
j'aimerai envoyer le fichier actif a 1 voir 2 destinataires au moyen d'un bouton.
sans intervention de l'utilisateur sous l'application de messagerie.

1ere methode employee:
ActiveWorkbook.SendMail Recipients:="destinataire@laposte.net"
il ouvre bien incredimail mais rien ne se passe.

2eme methode employee:
Dim ol As Object, myItem As Object
Dim strHtml As String
strHtml = "Bonjour , <BR>"
strHtml = strHtml & "<B><font size=6mm>" & _
"vous trouverez ci joint le fichier EDF</font></B>"
strHtml = strHtml & "<BR><BR><BR>" & _
"<font color=red>Cordialement</font>" & "<BR>"
strHtml = strHtml & Environ("UserName")
strHtml = strHtml & ""
Set ol = CreateObject("outlook.application")
Set myItem = ol.CreateItem(olMailItem)
myItem.To = "destinataire@hotmail.fr"
myItem.Subject = "envoi d'un fichier attaché"
myItem.HtmlBody = strHtml
'fichier en cours d'utilisation envoyé en attaché:
myItem.Attachments.Add ActiveWorkbook.FullName
myItem.Send
Set ol = Nothing
une fenetre s'ouvre: un programme tente d'envoyer automatiquement du courrier electronique en votre nom etc.... autoriser? oui / non
choix effectue: oui
une autre fenetre s'ouvre: outlook n'est pas votre programme par defaut pour la messagerie etc.... par defaut? oui / non
choix effectue: non
une autre fenetre s'ouvre: office excel attend la fin de l'execution d'une action OLE d'une autre application etc... Ok
choix effectue: ok

3eme methode employee:
Dim outApp As New Outlook.Application
Dim Dest As Outlook.Recipient
Dim Msg As Outlook.MailItem
Set Msg = outApp.CreateItem(0)
Msg.Subject = "Mise A Jour - Fichier EDF"
Msg.Body = "Bonjour, " & vbLf & "Vous trouverez ci joint le Fichier EDF... " 'le corps du message
Msg.Attachments.Add "C:\\\\\\\\Suivi - EDF (Roby).xls"
Set Dest = Msg.Recipients.Add("destinataire@hotmail.fr")
''Set Dest = Msg.Recipients.Add("Prenom1 Nom1") 'si present dans la liste des contacts
Msg.Send
une fenetre s'ouvre:type defini par l'utilisateur non defini
outApp As New Outlook.Application

4ème methode employee:
Dim iMsg As Object
Dim iConf As Object
Dim wb As Workbook
Dim WBname As String
' Dim Flds As Variant
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
' It will save a copy of the file in C:/ with a Date and Time stamp
WBname = "\" & wb.Name ''& " " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
'' wb.SaveCopyAs "C:/" & WBname
Set iMsg = CreateObject("CDO.Message")
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") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
With iMsg
Set .Configuration = iConf
.To = "destinataire@hotmail.fr"
.CC = ""
.BCC = ""
.From = """roby"" <expediteur@free.fr>"
.Subject = "Fichier EDF"
.TextBody = "Ci-joint la mise à jour fichier EDF..."
'' .AddAttachment "C:/" & WBname
.AddAttachment WBname
.Send
End With
'If you not want to delete the file you send delete this line
'' Kill "C:/" & WBname
Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True

une fenetre s'ouvre: fichier specifie introuvable
j'ai modifier la ligne suivante:
.AddAttachment "C:/" & WBname
par
.AddAttachment ActiveWorkbook.Path & WBname
une erreur: le processus ne peut pas acceder au fichier car ce fichier est utilise par un autre processus.


voila mon probleme.

merci d'avance A+ roby
 

Statistiques des forums

Discussions
312 216
Messages
2 086 351
Membres
103 195
dernier inscrit
martel.jg