Discussion :

[Loupire]

Bonjour j'ai un soucis sur un script, j'aimerais faire une copie de fichier dans un autre répertoire (copie de backup à la fin de la moulinette), j'ai essayé plusieurs méthodes mais hélas je n'arrive pas à régler ce problème...

Je vous explique :

L'utilisateur copie un fichier .doc dans un répertoire, mon VB passe ce fichier en .txt dans ce même répertoire et s'éxécute, au final un tableau .xls et créé avec des valeurs extraites de mon fichier .txt

J'aimerais qu'un fichier de Backup de mon fichier original en .doc soit créé et stocké dans un répertoire "Backup" si tout se déroule comme prévu.

Mes tests sont faits en fin de code à la place de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

'<<<<<<<<<<<< J'AI FAIS MES TESTS A CET ENDROIT >>>>>>>>>>>'

Voila les 3 tests effectués en vain :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
FileCopy "D:\Euromaster\Source\*.doc", "D:\Euromaster\Backup\*.doc"
MsgBox ("Fichier backup Euromaster créé dans D:\Euromaster\Backup\")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
SourceFichier = "D:\Euromaster\Source\*.doc" ' Définit le nom et le chemin du fichier source
DestinationFichier = "D:\Euromaster\Backup\" & "Euromaster_" & jour & ".doc" ' Définit le nom du fichier et le nouveau chemin cible
FileCopy SourceFichier, DestinationFichier ' Copie le fichier source dans le fichier cible.
MsgBox ("Fichier backup Euromaster créé dans D:\Euromaster\Backup\")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
FileSystemObject.CopyFile "D:\Euromaster\Source\*.doc", "D:\Euromaster\Backup\toto.doc"
MsgBox ("Fichier backup Euromaster créé dans D:\Euromaster\Backup\")

Voila mon code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Sub Import_Euromaster_6()
Dim ligne As String
Dim NbLigne As Long
Dim i As Long
Dim r As Long
Dim StartTab1 As Long
Dim EndTab1 As Long
Dim mon_tableau() As String
Dim MaRef As Variant
Dim MaDeal As Variant
On Error GoTo Err
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.OpenText Filename:="D:\Euromaster\Source\*.doc", Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\Euromaster\Source\import.txt", FileFormat:= _
xlText, CreateBackup:=False
SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
ActiveWorkbook.Save
ActiveWindow.Close
Range("A1").Select
 
Open ("D:\Euromaster\Source\import.txt") For Input As #1
 
    Do While Not EOF(1) '---> premiere boucle qui compte toutes les lignes du document
        Input #1, ligne
        NbLigne = NbLigne + 1
    Loop
 
Close #1
 
Open ("D:\Euromaster\Source\import.txt") For Input As #2 '---> ouverture du fichier en lecture
 
i = 1 '---> declaration des variables
StartTab = 1
EndTab = 0
 
ReDim mon_tableau(NbLigne, 10) '---> initialisation d'un tableau de X lignes et 9 colonnes
 
    Do While Not EOF(2) '---> debut de la seconde boucle
        Input #2, ligne
 
        If Left(ligne, 7) <> "" Then '---> les 7 premiers caracteres de la ligne sont differents de vide
            MaRef = Left(ligne, 7)
 
            If IsNumeric(MaRef) Then '---> les 7 premiers caracteres sont numeriques
 
                If Len(ligne) > 70 Then '---> la ligne des 7 premiers caracteres comporte plus de 50 caracteres
 
                mon_tableau(i, 1) = Mid$(ligne, 1, 7) & "0000" '---> je recupere les informations dans un tableau
                mon_tableau(i, 2) = Mid$(ligne, 20, 7)
                mon_tableau(i, 3) = Mid$(ligne, 76, 1)
                mon_tableau(i, 6) = "zta"
                mon_tableau(i, 7) = "43"
                mon_tableau(i, 8) = "RE"
                mon_tableau(i, 9) = "0"
                i = i + 1
                EndTab = EndTab + 1
 
                End If
 
            End If
 
        End If
 
        If Left(ligne, 18) = "NUMERO DE COMMANDE" Then '---> test sur numerro de commande
 
            For r = StartTab To EndTab
                mon_tableau(r, 4) = Mid$(ligne, 34, 3) '---> 3 premiers caractères du Purch. Order = Code Dealer
 
                Sheets("SAP").Select '---> correspondance entre Code Dealer (.xls) et Sold To Party (SAP)
                Columns("A:A").Select
 
                With Selection.Find(Mid$(ligne, 34, 3)).Activate
                On Error GoTo Err
                End With
 
                mon_tableau(r, 4) = ActiveCell.Value
                mon_tableau(r + 1, 10) = ActiveCell.Offset(0, 1).Value
 
                Sheets("RDCNORD").Select
 
            Next r
 
            For r = StartTab To EndTab
                mon_tableau(r, 5) = Mid$(ligne, 34, 3) & Mid$(ligne, 37, 4) '---> Purch. Order complet
            Next r
 
            StartTab = EndTab + 1
 
        End If
 
    Loop
 
Close #2
 
For r = 1 To EndTab
    Cells(r + 1, 1).Value = mon_tableau(r, 6) '---> Sales doc. type
    Cells(r + 1, 2).Value = mon_tableau(r, 7) '---> Sales org.
    Cells(r + 1, 3).Value = mon_tableau(r, 8) '---> Distr. Channel
    Cells(r + 1, 4).Value = mon_tableau(r, 9) '---> Division
    Cells(r + 1, 5).Value = mon_tableau(r + 1, 10) '---> Conversion Code Dealer / Sold to Party
    Cells(r + 1, 6).Value = mon_tableau(r, 1) '---> Material
    Cells(r + 1, 7).Value = mon_tableau(r, 2) '---> Customer Material
    Cells(r + 1, 8).Value = mon_tableau(r, 3) '---> Quantity
    Cells(r + 1, 10).Value = mon_tableau(r, 5) '---> Purch. Order complet
Next r
 
Application.DisplayAlerts = False
Range("A1").Select
Sheets("RDCNORD").Select '---> Selection de la page RDCNORD
Selection.CurrentRegion.Select '---> Selection de la plage
Selection.Copy
Workbooks.Add
ActiveSheet.Paste '---> Copie de la plage dans un nouveau classeur et nouvelle page
ActiveSheet.Rows.AutoFit '---> Ajustement automatique des lignes et colonnes du tableau
ActiveSheet.Columns.AutoFit
Sheets("Feuil2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Feuil3").Select
ActiveWindow.SelectedSheets.Delete
 
jour = Day(Now) & "_" & Month(Now) & "_" & Year(Now) '---> Declaration d'une variable jour
monfichier = "D:\Euromaster\Incoming\" & "Euromaster_" & jour '---> Creation du classeur a endroit precis
ActiveSheet.Name = "Euromaster_" & jour
 
    If Dir(monfichier & ".xls") <> "" Then '---> Verification si classeur existe deja
        MsgBox ("Un fichier IMPORT existe déjà, veuillez le supprimer/déplacer avant nouvelle copie")
 
    Else
 
        monfichier = monfichier & ".xls" '---> Classeur inexistant = creation classeur
        ActiveWorkbook.SaveAs Filename:= _
        monfichier, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=True '---> Fermeture automatique du nouveau classeur
        MsgBox ("Fichier d'import Euromaster créé dans D:\Euromaster\Incoming\")
 
    End If
 
 
'<<<<<<<<<<<< J'AI FAIS MES TESTS A CET ENDROIT >>>>>>>>>>>'
 
 
Kill ("D:\Euromaster\Source\import.txt")
Kill ("D:\Euromaster\Source\*.doc")
 
Application.DisplayAlerts = False
Application.Quit
 
Exit Sub
 
Err: MsgBox ("Aucune corresponce SAP pour le Code Dealer:" & Mid$(ligne, 34, 3) & vbCrLf & "Vérifier que le Code Dealer est bien référencé dans SAP")
SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
Kill ("D:\Euromaster\Source\*.doc")
Application.Quit
 
End Sub

Merci d'avance !

[FCL31]

Salut

Teste avec des parenthèse :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FileCopy ("D:\Euromaster\Source\*.doc"), ("D:\Euromaster\Backup\*.doc")

[Loupire]

Quand je fais ce test j'ai un message d'erreur ligne 53 :

Erreur d'éxécution '53' :
Fichier introuvable

La ligne 53 est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden

[FCL31]

Déjà je ne comprend pas pourquoi ton fichier s'appelle "*.doc"
et il est possible que tu ais un pbl de parenthèse dans ton code