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
| 'CREATION DES OBJETS
Set object_exec_cmd = CreateObject("WScript.Shell")
Set objet_connect_lecteur = CreateObject("WScript.Network")
Set objet_copie = CreateObject("Scripting.FileSystemObject")
'CONNEXION DU LECTEUR RESEAU
Function Connexion()
'Dim computername
'Récupération du nom de l'ordinateur
'computername = InputBox("Veuillez taper le nom de votre ordinateur svp (exemple FREL21524) :","Nom de votre ordinateur","")
'Déconnexion lecteur N:\ s'il existe
'ligne_cmd_deco = "net use /delete N:"
'Call object_exec_cmd.Run (ligne_cmd_deco)
'Connexion du lecteur réseau
ligne_cmd_connexion = "net use N: \\frer0645\out"
Call object_exec_cmd.Run (ligne_cmd_connexion)
End function
'VERIFICATION LECTEUR RESEAU CONNECTE AVANT COPIE
function Verif()
Connexion()
do while objet_copie.DriveExists("N:") = false
loop
end function
Function Copie_fichier()
Dim oFolder
Dim objFolderItem
Dim objPath
Dim copie
copie = 1
Option_noFolderButton = &H200
Verif() 'On vérifie que le lecteur réseau est bien connecté
'BOX SELECTION
Set objDialog=CreateObject("SAFRCFileDlg.FileOpen")
ObjDialog.OpenFileOpenDlg
'msgbox objDialog.FileName
If objDialog.FileName <> "" then 'Si l'user a choisit un fichier
'Récupération du chemin du fichier à copier
fichier_copie=objDialog.FileName
'BOX DESTINATION
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(0, "Selectionner le répertoire de destination",Option_noFolderButton,"")
'Récupération du chemin du répertoire de destination
If (not oFolder is nothing) then
Set objFolderItem = oFolder.Self
rep_dest = objFolderItem.Path
Else
copie = 0 'Si l'user annule, on ne copie pas
End if
'Copie du fichier du serveur vers le répertoire en local
If copie = 1 then
objet_copie.CopyFile fichier_copie,rep_dest,True
MsgBox "Le fichier est copié.",0, "Info"
Else
MsgBox "Vous avez annuler l'opération.",0, "Info"
End if
Set oFolder = nothing
Set oShell = nothing
Set objDialog = nothing
else
MsgBox "Vous avez annuler l'opération.",0, "Info"
End if
End function
'PROCEDURE PRINCIPALE
'COPIE FICHIER
Sub DownloadFile()
Copie_fichier()
End Sub |
