Bonjour à tous,
Je cherche en vain depuis quelques temps le moyen de récuperer le chemin complet d'un fichier trouvé via FileSearch pour l'attacher en outlook.
Mon répertoire ,C:\histos, contient des répertoires "année", des sous répertoires "mois" (jan, fev, mar, ..) eux mêmes contenant chacun 2 sous répertoires (AA et BB) dans lesquels des fichiers clients sont stockés.
Je cherche à automatiser l'envoi mensuel de mail à des clients en joignant leurs fichiers. Pour cela, je fait une recherche dans les sous/sous/sous répertoires du C:\histos\ sur base de l'identifiant client du mois et de l'année, ces trois critères étant repris dans le nom de ces fichiers (ex : client ABC fact 1234 26_05_10.xls).
Jusqu'ici pas de problème, je génère le mail, je trouve bien tous les fichiers par client pour le mois concerné (le mois précédent) mais PBM : je n'arrive pas à récupérer pour chaque fichier le chemin complet afin de les attacher en pièce jointe de mon mail.
Quelqu'un peut-il m'aider ou me proposer une soluce (j'ai essayéle FAQ, FSO mais ça ne donne rien) ?
Merci bcp
A+
Sub test2()
Dim MonOutlook, MonMessage, strNomattachment
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
Dim date_r As String
Dim datefile As String
Dim folder, client, filename, year
Dim daterapport As String
date_r = Format(Now - 30, " mm_yyyy")
datefile = Format(Now - 30, "mm_yy")
year = Format(Now - 30, "yyyy")
'DEFINITION REPERTOIRE ET CLIENT
folder = "C:\histos\" & year
client = "ABC"
'DESTINATAIRES
MonMessage.To = "moi@blabla.com"
'MESSAGE
MonMessage.Subject = "blabla" & date_r
MonMessage.body = "Dear toi" & vbCrLf & vbCrLf _
& "blabla. " & vbCrLf & vbCrLf _
& vbCrLf & "Bye" _
'ATTACHEMENT
Dim FS As FileSearch, i As Long, Nom As String
Set FS = Application.FileSearch
With FS
.NewSearch
.SearchSubFolders = True
.LookIn = folder
.filename = client & "*" & datefile & ".pdf"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Nom = Dir(.FoundFiles(i))
Next i
End If
End With
MonMessage.Attachments.Add -> PBM
MonMessage.Save
Set MonOutlook = Nothing
End Sub
Je cherche en vain depuis quelques temps le moyen de récuperer le chemin complet d'un fichier trouvé via FileSearch pour l'attacher en outlook.
Mon répertoire ,C:\histos, contient des répertoires "année", des sous répertoires "mois" (jan, fev, mar, ..) eux mêmes contenant chacun 2 sous répertoires (AA et BB) dans lesquels des fichiers clients sont stockés.
Je cherche à automatiser l'envoi mensuel de mail à des clients en joignant leurs fichiers. Pour cela, je fait une recherche dans les sous/sous/sous répertoires du C:\histos\ sur base de l'identifiant client du mois et de l'année, ces trois critères étant repris dans le nom de ces fichiers (ex : client ABC fact 1234 26_05_10.xls).
Jusqu'ici pas de problème, je génère le mail, je trouve bien tous les fichiers par client pour le mois concerné (le mois précédent) mais PBM : je n'arrive pas à récupérer pour chaque fichier le chemin complet afin de les attacher en pièce jointe de mon mail.
Quelqu'un peut-il m'aider ou me proposer une soluce (j'ai essayéle FAQ, FSO mais ça ne donne rien) ?
Merci bcp
A+
Sub test2()
Dim MonOutlook, MonMessage, strNomattachment
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
Dim date_r As String
Dim datefile As String
Dim folder, client, filename, year
Dim daterapport As String
date_r = Format(Now - 30, " mm_yyyy")
datefile = Format(Now - 30, "mm_yy")
year = Format(Now - 30, "yyyy")
'DEFINITION REPERTOIRE ET CLIENT
folder = "C:\histos\" & year
client = "ABC"
'DESTINATAIRES
MonMessage.To = "moi@blabla.com"
'MESSAGE
MonMessage.Subject = "blabla" & date_r
MonMessage.body = "Dear toi" & vbCrLf & vbCrLf _
& "blabla. " & vbCrLf & vbCrLf _
& vbCrLf & "Bye" _
'ATTACHEMENT
Dim FS As FileSearch, i As Long, Nom As String
Set FS = Application.FileSearch
With FS
.NewSearch
.SearchSubFolders = True
.LookIn = folder
.filename = client & "*" & datefile & ".pdf"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Nom = Dir(.FoundFiles(i))
Next i
End If
End With
MonMessage.Attachments.Add -> PBM
MonMessage.Save
Set MonOutlook = Nothing
End Sub
