Extraction piece jointe "CSV "
v
Bonjour,
J'ai récupérer le code ci- joint qui fonctionne parfaitement. cependant je souhaite le modifier afin qu'il me permette d'extraire que les fichiers joint au format CSV , je pense faut mettre ("*.csv*") après pceJointe
mais je dois être dans l'erreur.
Merci d'avance pour votre aide.
Sub Essai()
Extraction "Test", "tets@hotmail.com"
End Sub
Sub Extraction(NomDossier As String, Expediteur As String)
Dim olApp As Outlook.Application
Dim olSpace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olInbox As Outlook.MAPIFolder
Dim olmail As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim myItem As Object
Dim y As Integer, x As Integer
Set olApp = New Outlook.Application
Set olSpace = olApp.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders(NomDossier)
For Each olmail In olFolder.Items
If olmail.SenderEmailAddress = Expediteur And _
Not olmail.Attachments.Count = 0 Then
For y = 1 To olmail.Attachments.Count
Set pceJointe = olmail.Attachments(y)
x = x + 1
pceJointe.SaveAsFile "S:\.........." & pceJointe
' ActiveCell = olmail.Attachments(y)
' Workbooks.Open Filename:="S:\MKD......." & pceJointe, Local:=True
Set pceJointe = Nothing
Next y
End If
' olmail.Delete
Next olmail
bonjour vla92 le forum
peut être comme cela?
a+
papou
For y = 1 To olmail.Attachments.Count
Set pceJointe = olmail.Attachments(y)
if olmail.Attachments(y) like "*.CSV*" then
x = x + 1
pceJointe.SaveAsFile "S:\.........." & pceJointe
'ActiveCell = olmail.Attachments(y)
'Workbooks.Open Filename:="S:\MKD......." & pceJointe, Local:=True
end if
Set pceJointe = Nothing
Next y