Re : enregistrer et envoyer par mail feuille excel
Bon voila il s'agit d'un programme qui liste tous les fichiers (commençant par "Cl_") dans un répertoire, qui va chercher dans un onglet le mail de chaque client et qui envoie tous les fichiers par mail. Ensuite les fichiers envoyés vont dans un autre répertoire de l'ordinateur
Regarde si ça peut aller pour toi et si tu t'en sors
Attention pour faire fonctionner ce programme il faut aller dans VBA outils référence et valider toutes les références qui ont trait à outlook
Sub EnvoiMail()
Dim NomFich() As String, No As Integer, fich1 As String, chemin1 As String, chemin2 As String, mail1 As String, cli1 As String, efichier As String, dfichier As String
Dim myfso As Object, em1 As String, dest1 As String, pj1 As String
Dim olapp As Outlook.Application
Dim msg As MailItem
No = 0 'lister les fichiers dans le répertoire
fich1 = "Cl_*.xl*"
chemin1 = Sheets("Présentation").Range("K2")
chemin2 = Sheets("Présentation").Range("Q2")
ReDim NomFich(No)
NomFich(No) = Dir(chemin1 & fich1)
Do While NomFich(No) <> ""
No = No + 1
ReDim Preserve NomFich(No)
NomFich(No) = Dir()
Loop
For No = 0 To UBound(NomFich)
cli1 = Left(NomFich(No), 8) 'récupérer le n° du client dans le libellé du fichier
Set c = Sheets("Clients").Range("A6:A65000").Find(cli1)
If Not c Is Nothing And NomFich(No) <> "" Then
mail1 = c.Offset(0, 29) 'et récupérer l'adresse mail
pj1 = chemin1 & NomFich(No)
'envoyer le fichier sur l'adresse mail 'Penser à Outils/Références Outlook
'Paramétrer un compte dans outlook en sortie (voir aide dans gmail)
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = mail1
msg.CC = ""
msg.Subject = "Biostar AR de commande"
msg.Body = ""
'-- pj
msg.Attachments.Add Source:=pj1
Attendre 1
While Left(NomFich(No), 8) = Left(NomFich(No + 1), 8)
pj1 = chemin1 & NomFich(No + 1)
msg.Attachments.Add Source:=pj1
Attendre 1
No = No + 1
Wend
msg.Display 'ou Send sans validation manuelle
Attendre 1
End If
Next
No = 0 'déplacement des fichiers vers AR_envoye
For No = 0 To UBound(NomFich)
em1 = chemin1 & NomFich(No)
dest1 = chemin2 & NomFich(No)
While Dir(em1) <> ""
Set myfso = CreateObject("Scripting.FileSystemObject")
myfso.MoveFile em1, dest1
Attendre 5
Set myfso = Nothing
Wend
Next
End Sub
