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
A voir également:
Enregistrer des pieces Jointes d'un message (.xls) sans ecraser les precedents
