Enregistrer des pieces Jointes d'un message (.xls) sans ecraser les precedents [Résolu]

Signaler
Messages postés
2
Date d'inscription
mardi 21 avril 2009
Statut
Membre
Dernière intervention
22 avril 2009
-
Messages postés
580
Date d'inscription
mercredi 20 août 2008
Statut
Membre
Dernière intervention
20 avril 2010
-
Bonjour Messieurs,

J'aurais besoin d'enregistrer des pieces jointes excel (.xls) en provenance de reclamations magasins, et j'aimerai verifier que lorsque le fichier a deja ete enregistre, qu'il ne soit pas ecrase, mais renomme, et mieux qu'il soit renomme, par exemple avec la date et l'heure du message d'origine.

J'ai deja copie un code en provenance de votre site, mais la je cale..

Mon plus gros probleme, est que les magasin qui m'envoi le fichier exel on tous la meme matrice, donc je n'arrive pas a les distinguer les uns des autres... et en plus ce code m'ecrase les fichiers deja present dans le dossier.
Please...

Le code de mon UserForm :
Private Sub CommandButton1_Click()
    If OptionButton1 Then Magasin = 1
    If OptionButton2 Then Magasin = 2
    If OptionButton3 Then Magasin = 3
    If OptionButton4 Then Magasin = 4
    If OptionButton5 Then Magasin = 5
    If OptionButton6 Then Magasin = 6
    If OptionButton7 Then Magasin = 7
    If OptionButton8 Then Magasin = 8
    If OptionButton9 Then Magasin = 9
    If OptionButton10 Then Magasin = 10
    If OptionButton11 Then Magasin = 11
    If OptionButton12 Then Magasin = 12
    If OptionButton13 Then Magasin = 13
    If OptionButton14 Then Magasin = 14
    If OptionButton15 Then Magasin = 15
    If OptionButton16 Then Magasin = 16
    If OptionButton17 Then Magasin = 17
    If OptionButton18 Then Magasin = 18
    If OptionButton19 Then Magasin = 19
    If OptionButton20 Then Magasin = 20
    If OptionButton21 Then Magasin = 21
    If OptionButton22 Then Magasin = 22
    If OptionButton23 Then Magasin = 23
    If OptionButton24 Then Magasin = 24
    If OptionButton25 Then Magasin = 25
    If OptionButton26 Then Magasin = 26
    If OptionButton27 Then Magasin = 27
    If OptionButton28 Then Magasin = 28
    If OptionButton29 Then Magasin = 29
    If OptionButton30 Then Magasin = 30
    If OptionButton31 Then Magasin = 31
    If OptionButton32 Then Magasin = 32
    If OptionButton33 Then Magasin = 33
    If OptionButton34 Then Magasin = 34
   
    Unload ChoixDuMagasin
End Sub


Private Sub CommandButton2_Click()
End
End Sub

Et : 

Le code du module  :

Public Magasin As Integer, Chemin As String
'---------------------------------------------------------------------------------------------
'*** D'après un script publié par VBFRance (www.vbfrance.com)
Sub CopierFichierJoint()
        Dim OutlookApp As New Outlook.Application
        Dim OutlookExp As Outlook.Explorer
        Dim OutlookSélex As Outlook.Selection
        Dim x As Integer
        Dim i As Integer
        Dim NomFichier As String
        Dim NomFichierTemp As String
        Dim DossierDestination As String
        Dim DossierParDéfaut As String
        Dim DateRéception As String
        Dim fs
        'Procedure de traitement des messages
        Dim folder As String
        Set myOlApp = CreateObject("Outlook.Application")
        Set myNameSpace = myOlApp.GetNamespace("MAPI")
        Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
       
        ChoixDuMagasin.Show
        Select Case Magasin
        Case 1
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000011 - Chiajna")
        Case 2
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000012 - Orhideea")
        Case 3
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000013 - Colentina")
        Case 4
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000014 - Brasov")
        Case 5
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000015 - Ploiesti")
        Case 6
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000016 - Baneasa")
        Case 7
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000017 - Constanta")
        Case 8
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000018 - Unirea")
        Case 9
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000019 - Cluj")
        Case 10
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000020 - Iasi 2")
        Case 11
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000021 - Braila 1")
        Case 12
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000022 - Suceava 1")
        Case 13
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000023 - Arad 1")
        Case 14
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000024 - Pitesti")
        Case 15
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000025 - Vitantis")
        Case 16
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000026 - Iasi 1 ERA")
        Case 17
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000027 - Focsani")
        Case 18
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000028 - Sibiu")
        Case 19
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000029 - Buzau")
        Case 20
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000030 - Braila 2 Armonia")
        Case 21
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000031 - Oradea Lotus")
        Case 22
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000032 - Brasov 2 Magnolia")
        Case 23
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000033 - Berceni")
        Case 24
            Choix = ChoixDossierFichier("[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email\000034 - Oradea 2 ERA")
       
        If Choix = "" Then End
        End Select
        ChoixDuMagasin.Hide
       
        DossierParDéfaut = Choix & ""
        DossierDestination = DossierParDéfaut
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookExp = OutlookApp.ActiveExplorer
        Set OutlookSélex = OutlookExp.Selection
        If OutlookSélex.Count < 1 Then
            MsgBox "Il faut sélectionner un message avant!.", vbExclamation, "Erreur"
            Exit Sub
        End If
        For x = 1 To OutlookSélex.Count
            DoEvents
            DateRéception = OutlookSélex.Item(x).ReceivedTime
            NomFichier = OutlookSélex.Item(x)
            NomFichier = NomFichier & " (" & DateRéception & ")"
            NomFichier = Remplacement(NomFichier, "/", ".")
            NomFichier = Remplacement(NomFichier, "", "_")
            NomFichier = Remplacement(NomFichier, ":", ".")
            NomFichier = Remplacement(NomFichier, "*", "_")
            NomFichier = Remplacement(NomFichier, "?", "_")
            NomFichier = Remplacement(NomFichier, Chr(34), "_")
            NomFichier = Remplacement(NomFichier, "<", "_")
            NomFichier = Remplacement(NomFichier, ">", "_")
            NomFichier = Remplacement(NomFichier, "|", "_")
            i = 1
            NomFichierTemp = NomFichier
            On Error GoTo Erreur
            Set myItem = OutlookSélex.Item(x)
                If myItem.Attachments.Count > 0 Then
                    For pi = 1 To myItem.Attachments.Count
                        Set myAttachments = myItem.Attachments
                        'sauvegarde de la piece attachee
                        myAttachments.Item(pi).SaveAsFile DossierDestination & "" _
                        & myAttachments.Item(pi).DisplayName
                        Next
                Else
                    MsgBox "Le message " & NomFichier & " ne contient pas de fichier joint.", vbExclamation, "Erreur"
                End If
           
            Do While fs.FileExists(DossierDestination & NomFichier & ".msg") = True
                NomFichier = NomFichierTemp & " - " & i
                i = i + 1
            Loop
        Next x
        GoTo Fin
        End
Erreur:
        MsgBox "Ou Vous avez annule l'operation. ", vbOKOnly, "Erreur"
Fin:
End Sub
Function Remplacement(ByVal Texte As String, CarARemplacer As String, CarRemplacement As String) As String
    Dim c As Integer
    Do
        c = InStr(Texte, CarARemplacer)
        If c Then
            Texte = Left(Texte, c - 1) + CarRemplacement + Mid(Texte, c + Len(CarARemplacer))
        End If
    Loop While c
    Remplacement = Texte
End Function
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
    If SelType = 0 Then      FlagChoix &H1&: Msg "Choisissez un dossier :"
    Else      FlagChoix &H4000&: Msg "Choisissez un fichier :"
    End If
    'modifier le chemin par défaut ci dessous    'If Magasin 1 Then Racine "[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email"    'If Magasin 2 Then Racine "[file://\\10.56.1.10\Commun\1.2 \\10.56.1.10\Commun\1.2] - GESTION DE STOCK\1.3 - Litigii\1.0 - Email"
      
    Set objShell = CreateObject("Shell.Application")
    'le troisième paramètre permet de choisir
    'la sélection d'un dossier ou d'un fichier (0 ou 1)
    'le dernier paramètre permet de choisir le dossier racine
    Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix, Racine)
    On Error Resume Next
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
   
    If Chemin = "" Then Exit Function
    If objFolder.Title = "Bureau" Then
        Chemin = "C:"
    End If
    If objFolder.Title = "" Then
        Chemin = ""
    End If
    SecuriteSlash = InStr(objFolder.Title, ":")
    If SecuriteSlash > 0 Then
        Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoixDossierFichier = Chemin
End Function
---

MERCI D'AVANCE


Greg

Entreposage & Logistique
Responsable Gestion de stock

3 réponses

Messages postés
580
Date d'inscription
mercredi 20 août 2008
Statut
Membre
Dernière intervention
20 avril 2010
2
euh t'aurait put expliquer ton soucis en 2 lignes au lieu de 1000
pour vérifier l'existence d'un fichier :


private sub verifier(byval path)


If Dir(path, vbHidden) <> "" Then
    'le fichier existe (vbHidden permet de le retrouver même s'il est caché)
End If

si tu veut le renomé :


Name <code class="vb_literal1">"
chemin fichier et nom
"
As
"
chemin fichier et nom
"
</code>







Les yeux montrent la force de l'âme
Messages postés
2
Date d'inscription
mardi 21 avril 2009
Statut
Membre
Dernière intervention
22 avril 2009

Salut,

excuse moi pour le mess. a rallonge, ce fut le premier.

Merci pour ta solution ok, mais je ne sais pas comment l'integrer a mon code.
La tu doit rigoler...mais je bidouille et donc je suis a peine debutant.

Greg

Entreposage & Logistique
Responsable Gestion de stock
Messages postés
580
Date d'inscription
mercredi 20 août 2008
Statut
Membre
Dernière intervention
20 avril 2010
2
d accord demain matin je te ferais un bon exemple (pourquoi je dois rigoler)
bonne nuit

Les yeux montrent la force de l'âme