Sauvegarder tout sauf les .gif et les .bmp [VBA] - VB/VBA/VBS - Programmation
Marsh Posté le 17-08-2005 à 09:55:48
Bonjour,
La seconde boucle For each de ton code permet de parcourir les fichiers joints d'un message. Ca ne sert a rien de regarder pour chacun d'entre eux si le sujet du message correspond ou non (autant le verifier avant de parcourir les fichiers joints).
En revanche, c'est a ce moment que tu peux verifier que l'extension du nom de ton fichier n'est pas un "gif" ou un "bmp" (ou n'importe quel autre test sur le nom de ton fichier joint).
J'ai modifie ton code afin de faire ce que je viens de t'expliquer. Mais il y a d'autre facon de recuperer l'extension du fichier (la j'ai fait au plus simple, mais ce n'est pas rigide du tout..)
llllllllll a écrit : Bonjour a tous, |
En esperant avoir repondu a ta question.
Cordialement,
Marsh Posté le 22-08-2005 à 14:52:53
Bonjour Gandalf,
Merci pour ta reponse!
C'est exactement ce que je cherchais!
Je galerais vraiment a ce niveau la.
Le seul probleme maintenant c'est que plus rien ne marche depuis que j'ai installe WIndows XP 64 bits... sais-tu si il y a des incompatibilites?
Marsh Posté le 22-08-2005 à 15:07:58
llllllllll a écrit : Bonjour Gandalf, |
Non desole, je n'en ai pas la moindre idee
Mais je vois mal le rapport entre ton code et ton OS. Verifie plutot si tu as changé de version de Outlook, ou de version de visual basic. Et dans ce cas la, regarde quels sont les differences par rapport aux versions que tu avais avant.
Marsh Posté le 23-08-2005 à 15:53:43
En fait c'etait le Firewall du nForce4 qui est un peu pointilleux
Ca marche parfaitement maintenant!
Juste une derniere petite question, le code "final" est comme ca:
For Each Item In DAS.Items
A = False
If InStr(Item.Subject, "abc" ) > 0 Or _
InStr(Item.Subject, "ABC" ) > 0 Then
For Each Atmt In Item.Attachments
extension = Right(Atmt.FileName, 3)
If extension = "doc" Or extension = "htm" Or extension = "html" _
Or extension = "pdf" Or extension = "pps" Or extension = "ppt" _
Or extension = "xls" Then
A = True
FileName = "C:\ABC\" & _
Format(Item.CreationTime, "yymmdd_" ) & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
End If
If A Then
Item.UnRead = False
Item.Delete
End If
Next Item
Le probleme est que cela ne marche pas pour les fichiers joints de type "html" (extension de 4 caracteres), et si je change pour 4, les 3 (pdf etc.) ne sont pas sauvegardes
J'ai essaye de bidouiller un peu avec des boolean and/or mais ca ne m'a pas avance a grand chose...
Tu n'aurais pas une idee pour rajouter des extensions de fichiers de quatre lettres?
Merci encore,
Marsh Posté le 24-08-2005 à 09:49:36
Ben je t'ai dis que ce n'etait qu'un exemple le coup du Right(nom, 3) pour recuperer l'extension, mais que pour le faire correctement, il faut rechercher le dernier "." dans la chaine de caracteres (InStrRev) et renvoyer la chaine qui suit cette position (Mid)
Code :
|
Marsh Posté le 15-08-2005 à 09:53:51
Bonjour a tous,
J'ai ecrit tant bien que mal une macro sous Outlook qui permet de sauvegarder automatiquement les fichiers joints dans un repertoire en fonction des mots-cles dans le sujet et lui attribue une date. La macro sauvegarde tout les fichiers joints. Mais comment lui dire de ne pas sauvegarder les .gif et les .bmp par exemple? Je n'arrive pas a trouver cela dans l'aide... vous n'auriez pas une idee? voila la macro:
Sub DASAE()
On Error GoTo FDS_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Mail As MailItem
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim DAS As MAPIFolder
Set ns = GetNamespace("MAPI" )
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set DAS = Inbox.Folders("FDS" )
i = 0
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
For Each Item In FDS.Items
A = False
For Each Atmt In Item.Attachments
If InStr(Item.Subject, "123" ) > 0 Then
A = True
FileName = "\\Server\123\" & _
Format(Item.CreationTime, "yymmdd_" ) & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
If A Then
Item.UnRead = False
Item.Delete
End If
Next Item
'-----------------------------------------------------------------------------------
Merci!!!