Aide script multi-fonction

**Daffy13** · 22/12/2010, 09h55

Bonjour tout le monde,

Je vous explique dans un premier le projet global, pour que vous vous rendiez compte de ce que ca implique.

J'ai créer des tableaux croisés dynamiques qui vont chercher leur donnée dans deux fichiers qui changent de nom régulièrement. Un de ces deux fichiers nécessite l'éxecution d'une macro créer dans un fichier excel qui uniquement comme fonctionnalité la macro.

Ce que je veux que fasse le script :
1 -Qu'il me donne le choix de la base de donnée sur laquelle travailler (2 bases). Pour cette partie, j'avais pensé a faire des MsgBox imbriqué l'une dans l'autre.

2 -En fonction de la base de donnée choisit, vérifier (les bases se situent dans un répertoire du répertoire parent du script) si une base plus récente existe (la base du nom du fichier est toujours le meme).

3 -Si une nouvelle base existe, demander si on l'utilise ou pas.

4 -Si on l'utilise, on copie la nouvelle base dans un dossier nommé "..\sources" sous un nom simplifier,on exécute le fichier macro, et on lance le tableaux croisé dynamique correspondant.

5 -Si on ne utilise pas la nouvelle base, on execute directement le tableaux criosé dynamique correspondant.

Voilà en gros ce que je veux faire ! Les différentes fonctions que j'ai donc créer en récupérant du code a droite a gauche (je ne maitrise pas bien ce language) :

Fonction copie de fichier :

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
Function CopyFile(Path As String)
 
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")
 
	Dim dossier
	Set dossier = objFSO.GetFolder(Path)
 
		If objFSO.FileExists(dossier,fileUse) Then
			objFSO.CopyFile (dossier,FileUse) , "..\sources\"
		Else
			Msgbox "Fichier CMDB introuvable", vbExclamation
		End If
	Set objFSO = Nothing
 
End Function

Fonction de vérification de fichier plus récent:

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
Function FindLastFile(Path As String)
	Dim fName As String
	Dim fDate As Date
 
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	Dim folder
	Set folder = fso.GetFolder(Path)
 
	Dim Files
	Set Files = folder.Files
 
	Dim File
	For Each File In Files
		If File.DateCreated > fDate Then
			fDate = File.DateCreated
			fName = File.Name
		End If
		Debug.Print File.Name, File.DateCreated, "=>", fName, fDate
	Next
 
	Set Files = Nothing
	Set folder = Nothing
	Set fso = Nothing
 
	FindLastFile = fName
 
End Function

Lancement de la macro :

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
Function MacroExec()
Dim objXLApp
Set objXLApp = CreateObject("Excel.Application")
 
objXLApp.Workbooks.Open "./macro.inv.xlsm"
objXLApp.visible = true
objXLApp.DisplayAlerts = False
 
objXLApp.Run "macro.inv.xlsm!EXEC"
 
 
objXLApp.DisplayAlerts = False
objXLApp.Quit 
End Function[/quote]
 
Comparaison des fichiers plus récent : 
[quote]Function compare_file(Path As String)
 
Dim objFSOO
Set objFSOO = CreateObject("Scripting.FileSystemObject")
 
Dim dirComp
Set dirComp = objFSOO.GetFolder(Path)
 
Dim courant_dir
courant_dir = WScript.ScriptFullName 
courant_dir=left(courant_dir,InStrRev(courant_dir,"\"))
 
If FileDateTime(dirComp) > FileDateTime(current_dir,"*.*") then
	answer = MsgBox ("Un fichier plus recent est disponible, voulez-vous l'utilisez?",vbYesNo,"Nouveau Fichier")
		If answer = 6 Then
		Else
		MsgBox "Vous avez choisit de ne pas utiliser la derniere version du fichier"
Else
MsgBox "Aucun nouveau fichier disponible!"
 
End Function

Voilà, j'ai fait plusieurs fonctions, sans être vraiment sûr que celles-ci fonctionnent et je ne sais pas comment imbriquer tout ça

Merci d'avance

**Daffy13** · 22/12/2010, 14h24

Bon, je pense avoir avancé de mon côté, même si j'ai encore des alertes ...

Je vais découpé le code:

Cette première partie traite les variables et fonctions

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
' Declaration des variable de chemin
Dim RootDir,InfoDir,CodeDir,DataDir,InventDir,CmdbDir,UnixDir
RootDir = "C:\ParcUnix\"
InfoDir = RootDir + "InfoParcUnix\"
CodeDir = InfoDir + "code"
DataDir = InfoDir + "donnees"
InventDir = Rootdir + "Inventaires\"
CmdbDir = InventDir + "Cmdb\"
UnixDir = InventDir + "Inventaire_serveurs_unix\"
 
' Déclaration des classes de fichier
Class data
	Dim nom
	Dim version
End Class
' Ajout des objets FSO
'd_file représente la date du fichier
 
Dim fso, d_file
Set fso = CreateObject("Scripting.FileSystemObject")
 
' Fonction de recherche de la date du fichier
Function ShowFileDate(filespec)
Set d_file = fso.GetFile(filespec)
ShowFileDate=d_file.DateLastModified
End Function
 
' Création des deux objets data
Set cmdb=new data
cmdb.nom = "cmdb.xls"
cmdb.chemin = DataDir&cmdb.nom
cmdb.version=("ShowFileDate(cmdb.chemin)")
Set unix=new data
unix.nom = "inventaire.xls"
unix.version=("ShowFileDate(unix.chemin)")
unix.chemin = DataDir&unix.nom
 
' Copie de fichier cmdb
' Variable a définir : RecentFile
Function CopyCMDB
Const OverWriteFiles = TRUE
fso.CopyFile CmdbDir&Recentfile , cmdb.chemin , OverWriteFiles
End Function
 
' Copie de fichier unix
' Variable a définir : Recentfile
Function CopyUnix
Const OverWriteFiles = TRUE
fso.CopyFile UnixDir&RecentFile , unix.chemin , OverWriteFiles
End Function

Cette seconde partie est " l'interface "

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
' On declare la variable ChoiceSelect et ChoiceSelect2
Dim ChoiceSelect,ChoiceSelect2,Replace,objXLApp
Set objXLApp = CreateObject("Excel.Application")
' On démarre la premiere MsgBox d'entrée
ChoiceSelect = msgbox ("Voulez-vous utiliser la base de donnee CMDB?", VbYesNo, "Choix de l'application")
	If ChoiceSelect = 6 Then ' Choix YES
		If ShowFileDate(CmdbDir&"*.xls") > cmdb.version Then ' Si le fichier est plus recent
			Set RecentFile = ShowFileDate(CmdbDir&"*.xls")
			Replace = msgbox ("Une version plus recente de la base de donnee existe, voulez-vous l'utiliser?", VbYesNo, "Choix de l'application")
				If Replace = 6 Then
					CopyCMDB
					objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
					objXLApp.visible = true
				else
					objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
					objXLApp.visible = true
				End If
		Else 
			objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
			objXLApp.visible = true
		End If
	Else
		ChoiceSelect2 = msgbox ("Voulez-vous utiliser la base de donne Inventaire Unix?", VbYesNo, "Choix de l'application")
			If ChoiceSelect2 = 6 Then
				If ShowFileDate(UnixDir&"*.xls") > unix.version Then
					Set RecentFile = ShowFileDate(UnixDir&"*.xls")
					Replace = msgbox ("Une version plus recente de la base de donnee existe, voulez-vous l'utiliser?", VbYesNo, "Choix de l'application")
						If Replace = 6 Then
							CopyUnix
							objXLApp.Workbooks.Open CodeDir&"macro.inv.xlsm"
							objXLApp.visible = true
							objXLApp.DisplayAlerts = False
							objXLApp.Run "macro.inv.xlsm!EXEC"
							objXLApp.DisplayAlerts = False
							objXLApp.Workbooks.Close
							objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
						else
							objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
							objXLApp.visible = true
							objXLApp.DisplayAlerts = False
						End If
				else
				objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
				objXLApp.visible = true
				objXLApp.DisplayAlerts = False
				End If
			Else
				Msgbox "Adios"
			End If
	End if

**Daffy13** · 22/12/2010, 16h42

Bon, je me réponds a moi même si ca peut aider d'autres personnes, j'ai finalement réussit dans l'intégralité ce que je voulais faire

Partie fonction & variables:

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
Option Explicit
 
Dim RootDir,InfoDir,CodeDir,DataDir,InventDir,CmdbDir,UnixDir
RootDir = "C:\ParcInfo\"
InfoDir = RootDir + "InfoParcUnix\"
CodeDir = InfoDir + "code\"
DataDir = InfoDir + "donnees\"
InventDir = Rootdir + "Inventaires\"
CmdbDir = InventDir + "Cmdb\"
UnixDir = InventDir + "Inventaire_serveurs_unix\"
 
' Déclaration des classes de fichier
Class data
	Dim nom
	Dim version
	Dim chemin
End Class
' Ajout des objets FSO
'd_file représente la date du fichier
 
Dim fso, d_file
Set fso = CreateObject("Scripting.FileSystemObject")
 
' Fonction de recherche de la date du fichier
Function ShowFileDate(filespec)
Set d_file = fso.GetFile(filespec)
ShowFileDate=d_file.DateLastModified
End Function
 
' Création des deux objets data
Dim cmdb, unix
Set cmdb = new data
cmdb.nom = "cmdb.xls"
cmdb.chemin = DataDir&cmdb.nom
cmdb.version= ShowFileDate(DataDir&cmdb.nom)
Set unix=new data
unix.nom = "inventaire.xls"
unix.version= ShowFileDate(DataDir&unix.nom)
unix.chemin = DataDir&unix.nom
 
' Copie de fichier cmdb
' Variable a définir : RecentFile
Function CopyCMDB
Const OverWriteFiles = TRUE
fso.CopyFile CmdbDir&LastCMDBfile , cmdb.chemin , OverWriteFiles
End Function
 
' Copie de fichier unix
' Variable a définir : Recentfile
Function CopyUnix
Const OverWriteFiles = TRUE
fso.CopyFile UnixDir&LastUNIXfile , unix.chemin , OverWriteFiles
End Function
 
' Dernier Fichier present dans les sources
Function FindLastFile(Path)
	Dim FileName
	Dim FileDate
	Dim FileDir
	Dim Files
	Dim File
	Set FileDir = fso.GetFolder(Path)
	Set Files = FileDir.Files
	For each File in Files
		If File.DateCreated > FileDate Then
			FileDate = File.DateCreated
			FileName = File.Name
		End If
		'Debug.Print File.Name, File.DateCreated, "=>", FileName, FileDate
	Next
	Set Files = Nothing
	Set FileDir = Nothing
 
	FindLastFile = FileName
End Function
 
' Variable dernier fichier
Dim LastCMDBfile,LastUNIXfile,LastDateCMDBfile,LastDateUNIXfile
LastCMDBfile = FindLastFile(CmdbDir)
LastUNIXfile = FindLastFile(UnixDir)
LastDateCMDBfile = ShowFileDate(CmdbDir&LastCMDBfile)
LastDateUNIXfile = ShowFileDate(UnixDir&LastUNIXfile)
 
'' FONCTION MODE D'EMPLOI
Function mode_emploi
Msgbox "Le mode d'emploi est disponible en haut du tableau", vbInformation, "Mode d'emplois"
End Function

Et la partie que j'appelle interface, où l'utilisateur réagit :

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
' On declare la variable ChoiceSelect et ChoiceSelect2
Dim ChoiceSelect,ChoiceSelect2,Replace,objXLApp,RecentFile
Set objXLApp = CreateObject("Excel.Application")
' On démarre la premiere MsgBox d'entrée
ChoiceSelect = msgbox ("Voulez-vous utiliser la base de donnee CMDB ?", VbYesNo, "Choix de l'application")
	If ChoiceSelect = 6 Then ' Choix YES
 
		If LastDateCMDBfile > cmdb.version Then ' On vérifie si un fichier plus récent est disponible
			Replace = msgbox ("Une version plus recente de la base de donnee existe, voulez-vous utiliser : "& LastCMDBfile & "?", VbYesNo, "Choix de l'application")
				If Replace = 6 Then
					CopyCMDB() ' Appel a la fonction de copie de fichier CMDB
					objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
					objXLApp.visible = true
					mode_emploi()
				else ' Si pas de fichier plus recent, on ouvre le tableau croise dynamique
					MsgBox "Vous utiliser la version CMDB datant du :" & cmdb.version & "",vbCritical, "Attention !"
					objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
					objXLApp.visible = true
					mode_emploi()
				End If
		Else 
			objXLApp.Workbooks.Open InfoDir&"INFOCMDB.xlsx"
			objXLApp.visible = true
			mode_emploi()
		End If
	Else
		ChoiceSelect2 = msgbox ("Voulez-vous utiliser la base de donne Inventaire Unix?", VbYesNo, "Choix de l'application")
			If ChoiceSelect2 = 6 Then
				If LastDateUNIXfile > unix.version Then
					Replace = msgbox ("Une version plus recente de la base de donnee existe, voulez-vous l'utiliser : "& LastUNIXfile & "?", VbYesNo, "Choix de l'application")
						If Replace = 6 Then
							CopyUnix()
							objXLApp.Workbooks.Open CodeDir&"macro.inv.xlsm"
							objXLApp.visible = false
							objXLApp.DisplayAlerts = False
							objXLApp.Run "macro.inv.xlsm!EXEC"
							objXLApp.DisplayAlerts = False
							objXLApp.Quit
							objXLApp.visible = True
							objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
							mode_emploi()
						else
							objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
							objXLApp.visible = true
							objXLApp.DisplayAlerts = False
							mode_emploi()
						End If
				else
				objXLApp.Workbooks.Open InfoDir&"INFOUNIX.xlsx"
				objXLApp.visible = true
				objXLApp.DisplayAlerts = False
				mode_emploi()
				End If
			Else
				Msgbox "Adios"
			End If
	End if

Peut être que mon code est pas très propre, mais il a le mérite de fonctionner

**Daffy13** · 24/12/2010, 09h27

Bonjour,

Voilà, je souhaite améliorer le script que j'ai réalisé. Comme vous pouvez-le voir dans le code précédent, toutes les variables sont déclarés au sein du fichier.

Maintenant, la seconde étape est externalisée les variables "RootDir" et "InventDir" dans un fichier texte placer dans le même répertoire que le script.

Le top serait d'auto-complété ce fichier parametre.txt, en comparant le Path actuel et le Path présent dans le fichier parametre.txt. A savoir RootDir représenterai le path complet situé à 2 répertoire au dessus de celui du script.

Je ne sais pas comment m'y prendre ...

Edit : après réflexion, si on peut définir la variable RootDir par un chemin relatif, du style "Path.Actuel - 2 répertoire" ...

**Daffy13** · 24/12/2010, 11h25

Bon ... je galère ...

J'ai essayer les chemins relatifs du type :

Code :

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

RootDir = "..\..\"

et ca marche pas

Là je suis partie sur un autre principe, en prenant le répertoire absolu du script - le nom du script j'obtiens le chemin du repertoire.

Seulement, il faut que je supprime 2 chaines de caractère séparé par "\", mais j'y arrive pas ...

Code :

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

RepScript = left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(wscript.ScriptName))

**l_autodidacte** · 24/12/2010, 16h05

Qu'à cela ne tienne :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim myPath
myPath=Wscript.ScriptFullName
MsgBox myPath
MyPath=Left(myPath,InstrRev(myPath,"\")-1)
MsgBox myPath
 
MyPath=Left(myPath,InstrRev(myPath,"\")-1)
MsgBox myPath
 
MyPath=Left(myPath,InstrRev(myPath,"\")-1)
MsgBox myPath

Place ce code dans un fichier à 3 ou 4 dossiers parents et tu verras qu'à chaque fois, il te retourne le dossier parent de l'actuel.

**pitchalov** · 27/12/2010, 12h43

Bonjour,

Il est aussi possible d'utiliser la méthode GetParentFolderName de l'objet FSO (qui te renvoie le chemin parent de celui rentré en paramètre) autant de fois que nécessaire :

Code :

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

RootDir = fso.GetParentFolderName(fso.GetParentFolderName(fso.GetParentFolderName(Wscript.ScriptFullName)))

**Daffy13** · 03/01/2011, 15h37

Merci ! Ces deux méthodes fonctionnent très bien !

Aide script multi-fonction

VBScript

Discussions similaires

Partager

Partager