[VBA] Sauvegarder tout sauf les .gif et les .bmp

Sauvegarder tout sauf les .gif et les .bmp [VBA] - VB/VBA/VBS - Programmation

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!!!

Reply

Marsh Posté le 15-08-2005 à 09:53:51   

Reply

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,
 
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, extension 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
        If InStr(Item.Subject, "123" ) > 0 Then
            For Each Atmt In Item.Attachments
               extension = Right(Atmt.FileName, 3)
               If extension <> "bmp" and extension <> "gif" Then
                A = True
                    FileName = "\\Server\123\" & _
                    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
'-----------------------------------------------------------------------------------
 
Merci!!!


 
En esperant avoir repondu a ta question.
 
Cordialement,


---------------
Guendalf
Reply

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?

Reply

Marsh Posté le 22-08-2005 à 15:07:58    

llllllllll a écrit :

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?


 
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.


---------------
Guendalf
Reply

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,

Reply

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 :
  1. Public Function fExtension(sFile As String) As String
  2. Dim nDotPos As Integer
  3. nDotPos = InStrRev(sFile, "." )
  4. If nDotPos = 0 Then nDotPos = Len(sFile)
  5. fExtension = Mid(sFile, nDotPos + 1)
  6. End Function


---------------
Guendalf
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed