envoie mail avec PJ " répertoireAppli"

[julie999]

bonjour j'utilise un code vba de JB
que j'ai adapter a mes besoins
par contre j'ai un petit souci
je travaille avec excel 2010 et outlook 2010(sans mot de passe)
sur mon pc au a la maison tous se passe bien aucun problème
les sauvegardes de document se font sur le disque dur C

au travaille j'utilise aussi excel 2010 et outlook 2010(avec mot de passe)
et la la macro bloque sur repertoire appli
apparemment c'est un problème de chemin ou je me trompe ??
les sauvegardes de document se font sur le réseau de l'entreprise

voici le code que j'utilise

Sub envoi_Feuille()
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path

Sheets(Array("RECEPTION", "cross docking")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Cross docking PHOTOBOX du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("destinataires email").Select
Range("A15").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A6").Value & Chr(13) & Chr(13) & Range("A7").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) & Range("A9").Value & Chr(13) & Chr(13) & Range("A12").Value & Chr(13) & Chr(13)
msg.Attachments.Add répertoireAppli & "\Cross Docking PHOTOBOX du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing

Application.ScreenUpdating = True
MsgBox "Le Cross Docking a été envoyé par email avec succès ...."
End Sub

auriez vous une idée du problème
peut on contourner ce repertoire appli
en plus chez moi a chaque envoie de mail une copie de la feuille s'enregistre sur le bureau c'est embêtant ça y a t il possibilité de le supprimer en fin de macro

merci de votre Julie

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Bonsoir Julie, le forum,

C'est bizarre, avant de lancer ta macro, tu as bien enregistré ton fichier dans un répertoire ?

Lorsque tu utilises ActiveWorkBook.path, cela enregistre où tu as mis ton fichier. Si tu souhaite changer ton répertoire, il faut modifier la ligne

répertoireAppli = ActiveWorkbook.Path

par

répertoireAppli = "C:\Ton nouveau répertoire\voir sous répertoire

Pour la suppression il faut utiliser

Kill NOM_FICHIER

J'aurai plutôt tendance à écrire ta macro comme ça :

Sub envoi_Feuille()
 Application.ScreenUpdating = False
 répertoireAppli = ActiveWorkbook.Path
 Nom_Fichier = répertoireAppli & "\Cross docking PHOTOBOX du " & _
 Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
 
 Sheets(Array("RECEPTION", "cross docking")).Copy
 Application.DisplayAlerts = False
 ActiveWorkbook.SaveAs Nom_Fichier
 ActiveWindow.Close
    '--- Envoi par mail
    Dim olapp As Object 'Outlook.Application
    Sheets("destinataires email").Select
    Range("A15").Select
    Set olapp = CreateObject("Outlook.Application")
    Do While Not IsEmpty(ActiveCell)
      Dim msg As Object 'MailItem
      Set msg = olapp.CreateItem(0)
      msg.To = ActiveCell.Value
      msg.Subject = Range("A2").Value
      msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A6").Value & Chr(13) & Chr(13) & Range("A7").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) & Range("A9").Value & Chr(13) & Chr(13) & Range("A12").Value & Chr(13) & Chr(13)
      msg.Attachments.Add Nom_Fichier
      msg.Send
      ActiveCell.Offset(1, 0).Select
    Loop
 Set msg = Nothing
 Set olapp = Nothing
 Kill Nom_Fichier
 Application.ScreenUpdating = True
 MsgBox "Le Cross Docking a été envoyé par email avec succès ...."
End Sub

En nommant ton fichier Nom_Fichier tu n'est pas obligé de remettre toutes tes lignes.

A te relire

Martial

 

[julie999]

Re : envoie mail avec PJ " répertoireAppli"

bonsoir yaloo,le fil
je vais tester des mon retour
par contre avant de lancer la macro le fichier n'est pas enregistrer il envoie les feuilles actives
c'est vrais qu'il serait mieux d'envoyer les feuille enregistrer mais le code ne convient plus peut etres
Julie

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Re,

Il me semble que c'est mieux de l'enregistrer sur ton disque dur, après tu peux créer un autre répertoire pour tes fichiers.

A+

 

[cindy75015]

Re : envoie mail avec PJ " répertoireAppli"

re yaloo
le code bloque sur msg.Send



voici le code
Sub envoi_Feuille()
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path
Nom_Fichier = répertoireAppli & "\Cross docking PHOTOBOX du " & _
Format(Worksheets("Cross Docking").Range("a4"), "d\-mm\-yyyy") & ".xls"

Sheets(Array("Réception", "Cross Docking")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Nom_Fichier
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("A15").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A6").Value & Chr(13) & Chr(13) & Range("A7").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) & Range("A9").Value & Chr(13) & Chr(13) & Range("A12").Value & Chr(13) & Chr(13)
msg.Attachments.Add Nom_Fichier
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
Kill Nom_Fichier
Application.ScreenUpdating = True
MsgBox "Le Cross Docking a été envoyé par email avec succès ...."
End Sub


Julie

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Bonjour Julie, bonjour à tous,

Quel message d'erreur as-tu lorsque ta macro bloque ?

Martial

 

[cindy75015]

Re : envoie mail avec PJ " répertoireAppli"

re
ca bloque sur
msg.Send "imposible de reconaitre un ou plusieur nom"


le kill ne supprime pas le fichier ais je oublier quelque chose

Sub envoi_Feuille()
Application.ScreenUpdating = False
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path
Nom_Fichier = répertoireAppli & "\Cross docking PHOTOBOX du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"

Sheets(Array("Réception", "Cross Docking")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Nom_Fichier
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("A15").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A6").Value & Chr(13) & Chr(13) & Range("A7").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) & Range("A9").Value & Chr(13) & Chr(13) & Range("A12").Value & Chr(13) & Chr(13)
msg.Attachments.Add Nom_Fichier
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
Kill Nom_Fichier

Application.ScreenUpdating = True
MsgBox "Le Cross Docking a été envoyé par email avec succé ...."
End Sub

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Re,

J'ai trouvé ce lien concernant le message d'erreur. Je ne sais pas si ça fonctionne, non testé.

A+

 

[cindy75015]

Re : envoie mail avec PJ " répertoireAppli"

re yaloo le fil

bien vu c’était bien ça l'erreur
je me suis cassé la tête a changer les codes et ça n'avais rien a voir


parcontre je n'arrive pas a supprimer le fichier que me creer la macro
j'aimerais en fin de macro supprimer le fichier qu'il a créer juste avant
kill ou delete
j'ai mis Kill Nom_Fichier mais ça ne marche pas
que puis je mettre
Cindy

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Bonjour Julie, Cindy et les autres,

Alors je ne comprend pas.

Tes mails sont bien envoyés avec le fichier en pièce jointe ?

Si oui, c'est bien que le fichier existe. Si le fichier existe avec ce nom et dans le répertoire indiqué, il doit être supprimé avec Kill Nom_Fichier.

Je ne vois pas d'autre solution. As-tu essayé en pas à pas (avec F8) pour voir si la ligne Kill Nom_Fichier est bien passée ?

A+

Martial

 

[cindy75015]

Re : envoie mail avec PJ " répertoireAppli"

re yaloo ,le fil
le mail est bien envoyé,le fichier est bien enregistrer mais la macro bloque sur Kill Nom_Fichier(en jaune)
Cindy

 

[Yaloo]

Re : envoie mail avec PJ " répertoireAppli"

Re,

Et dans ta variable tu as quoi à ce moment là ?

Juste avant le Kill Nom_Fichier tu mets Msgbox Nom_Fichier afin de vérifier si c'est bien le nom et le chemin du fichier à supprimer.

A+

Martial

 

[julie999]

Re : envoie mail avec PJ " répertoireAppli"

re
Msgbox Nom_Fichier
me renvoi une boite de dialogue vide
cindy

 

[julie999]

Re : envoie mail avec PJ " répertoireAppli"

re le fil
ok fil resolu
k'ai changé la destination de repertoir appli

répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"


et utilise ce code pour supprimer le contenu


Dim Fic As String
Fic = Dir("C:\Archives photobox\Dossier tempo pour email\*.xls")
Do While Fic <> ""
Kill "C:\Archives photobox\Dossier tempo pour email\" & Fic
Fic = Dir
Loop

cindy