VBscript et Base de donnée Access

Résolu/Fermé

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 - 14 juin 2005 à 11:30
stéphane - 23 mai 2008 à 09:46

bonjour
donc voila mon souci j ai mon script qui me permet de recuperer l espace de mes disques ainsi que l espace libre en pourcent je souhaiterais stocker ces informations horodatées dans une base de type Access et faire des remonter d'alerte via Lotus si un volume est en dessous d un seuil pre-defini.
Alors est ce que quelqu un pourrai m orienter sur la bonne voie parce que je ne sais pas su tout commnt faire comme je suis debutant En VBscript voila merci d avance a tous!!!

voici mon script pour vous donner un idée :

' FreeSpace.vbs
' Montrez l'espace disque libre pour toutes les disques locaux

' Check command line parameters
Select Case WScript.Arguments.Count
Case 0
' Default if none specified is local computer (".")
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputer = objItem.Name
Next
Case 1
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = Wscript.Arguments(0)
if InStr( strComputer, "?" ) > 0 Then Syntax
Case Else
' Maximum is 1 command line parameter
Syntax
End Select

Display( strComputer )
WScript.Quit(0)

Function Display( strComputer )
strMsg = vbCrLf & "Name:" & vbTab & "Drive:" & vbTab & "Size:" & _
vbTab & "Free:" & vbTab & "% Free:" & vbCrLf & "=====" & _
vbTab & "======" & vbTab & "=====" & vbTab & "=====" & _
vbTab & "=======" & vbCrLf
On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err.Number Then
WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _
" " & Err.Description
Err.Clear
Syntax
End If
On Error GoTo 0
' Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where MediaType=12",,48)
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48)
For Each objItem in colItems
strMsg = strMsg & strComputer & vbTab & _
objItem.Name & vbTab & _
CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) ) & _
vbTab & _
CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) ) & _
vbTab & _
CStr( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & _
vbCrLf
Next
'WScript.Echo strMsg => cette commande m affcihe le resultat dans une MSGBOX
'Cela permet de m afficher mon resultat sur une page Web
dim IE
set ie = createobject("Internetexplorer.application")
ie.navigate("about:blank")
do while ie.document.readystate<>"complete"
wscript.sleep 100
loop
ie.document.body.innertext = strmsg
ie.visible = true
set ie = nothing
End Function

A voir également:

VBscript et Base de donnée Access
Base de registre - Guide
Formules excel de base - Guide
Formules mathématiques de base - Télécharger - Études & Formations
La base de données de sécurité du serveur n'a pas de compte d'ordinateur pour la relation ✓ - Forum Réseau
Gigaset ne reconnait plus sa base - Forum telephonie fixe

17 réponses

Réponse 1 / 17

Utilisateur anonyme
14 juin 2005 à 20:35

Salut,

Voici un exemple pour te connecter sur access. Ceci est un
script fonctionnel non raffiné.

' COMMENT: <Compiler dans un fichier ACCESS toutes les informations
' des fichiers d'un lecteur
'=========================================================================================================
'
'Accèss au dossier d'un disque

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3

Const MoteurDeRecherche = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

'
' Déclaration des variables de la base de données ACCESS
'
Dim oFS

Dim objConnection
Dim objRecordset
Dim AccesFichier

Dim NumCD
Dim NomCD
Dim NomLog
Dim NomApp

'(37) Debut du programme

' On Error Resume Next

Flag = False

msgTexte = "Entrez le numéro du CDROM à lire : " & vbCrLf & "( ex.: CD1001 )"
NumCD = InputBox(msgTexte, "Saisie du numéro du CDROM à lire", "CDR10010")

msgTexte = "Entrez le nom du CDROM à lire : " & vbCrLf & "( ex.: WINDOWS XP PRO )"
NomCD = InputBox(msgTexte, "Saisie du nom du CDROM à lire", "SOURCES #1")

msgTexte = "Entrez le nom du logiciel : " & vbCrLf & "( ex.: Microsoft Word )"
NomLog = InputBox(msgTexte, "Saisie du fichier à créer", "DOCUMENTS")

msgTexte = "Entrez le nom de l'application : " & vbCrLf & "(ex.: Microsoft Word)"
NomApp = InputBox(msgTexte, "Saisie du fichier à créer", "DONNÉES")

msgTexte = "Entrez le nom du fichier : " & vbCrLf & "(ex.: C:\CDROM.MDB)"
Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "K:\CDROM.MDB")

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")

Set oFS = CreateObject("Scripting.FileSystemObject")

Disque = Mid(Fichier, 1, 2)

Set oLecteur = oFS.GetDrive(Disque)

If (oLecteur.IsReady) Then

AccesFichier = MoteurDeRecherche & Fichier
objConnection.Open AccesFichier
objRecordset.Open "SELECT * FROM LibrairieCDROM" , objConnection, adOpenStatic, adLockOptimistic

Lecteur = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire","H")
Set oLecteur = oFS.GetDrive(Lecteur)

If (oLecteur.IsReady) Then
Call Principal(Fichier)
Else
EnvoiMessage (0)
End If
Else
EnvoiMessage (0)
End If

'
'=========================================================================================================
'85
Sub Principal(ByVal nomFichier)

' On Error Resume Next

If (oLecteur.IsReady) Then

'Lecture des fichiers dans la racine du lecteur
If (oLecteur.RootFolder.Files.Count > 0) Then
For Each oFichier In oLecteur.RootFolder.Files
objRecordset.AddNew
objRecordset("Nom Fichier") = oFichier.Name
' objRecordset("Type Fichier") = oFichier.Type
objRecordset("Grandeur") = oFichier.Size
objRecordset("Chemin d'accès") = oFichier.Path
objRecordset("Date Créé") = oFichier.DateCreated
' objRecordset("Date Accédé") = oFichier.DateLastAccessed
objRecordset("Date Modifié") = oFichier.DateLastModified
objRecordset("Nom court") = oFichier.ShortName
objRecordset("Chemin court") = oFichier.ShortPath

Call ChercheAttributs (oFichier,CACHE,Reponse)
objRecordset("Attr CACHÉ") = Reponse
Call ChercheAttributs (oFichier,SYSTEME,Reponse)
objRecordset("Attr SYSTÈME") = Reponse
Call ChercheAttributs (oFichier,ARCHIVE,Reponse)
objRecordset("Attr ARCHIVE") = Reponse
Call ChercheAttributs (oFichier,LECTURE,Reponse)
objRecordset("Attr LECTURE SEULE") = Reponse
Call ChercheAttributs (oFichier,RACCOURCI,Reponse)
objRecordset("Attr RACCOURCI") = Reponse
Call ChercheAttributs (oFichier,COMPRESSE,Reponse)
objRecordset("Attr COMPRESSÉ") = Reponse

objRecordset("Numéro CDROM") = NumCD
objRecordset("Nom CDROM") = NomCD
objRecordset("Nom Logiciel") = NomLog
objRecordset("Nom Application") = NomApp

objRecordset.Update
Next
End If

'Lecture des sous-répertoires dans le lecteur

For Each oRepertoire In oLecteur.RootFolder.SubFolders
Call ListeFichier(oRepertoire)
Next

End If

' objRecordset.Close
objConnection.Close

WScript.Echo "Fin de traitement :-) "

End Sub
'179
'==========================================================================
'
Sub ListeFichier(ByVal oRepertoire)

Dim oDossier
Dim Reponse

' On Error Resume Next

If (oRepertoire.Files.Count > 0) Then
For Each oFichier In oRepertoire.Files
objRecordset.AddNew
objRecordset("Nom Fichier") = oFichier.Name
' objRecordset("Type Fichier") = oFichier.Type
objRecordset("Grandeur") = oFichier.Size
objRecordset("Chemin d'accès") = oFichier.Path
objRecordset("Date Créé") = oFichier.DateCreated
' objRecordset("Date Accédé") = oFichier.DateLastAccessed
objRecordset("Date Modifié") = oFichier.DateLastModified
objRecordset("Nom court") = oFichier.ShortName
objRecordset("Chemin court") = oFichier.ShortPath

Call ChercheAttributs (oFichier,CACHE,Reponse)
objRecordset("Attr CACHÉ") = Reponse
Call ChercheAttributs (oFichier,SYSTEME,Reponse)
objRecordset("Attr SYSTÈME") = Reponse
Call ChercheAttributs (oFichier,ARCHIVE,Reponse)
objRecordset("Attr ARCHIVE") = Reponse
Call ChercheAttributs (oFichier,LECTURE,Reponse)
objRecordset("Attr LECTURE SEULE") = Reponse
Call ChercheAttributs (oFichier,RACCOURCI,Reponse)
objRecordset("Attr RACCOURCI") = Reponse
Call ChercheAttributs (oFichier,COMPRESSE,Reponse)
objRecordset("Attr COMPRESSÉ") = Reponse

objRecordset("Numéro CDROM") = NumCD
objRecordset("Nom CDROM") = NomCD
objRecordset("Nom Logiciel") = NomLog
objRecordset("Nom Application") = NomApp

objRecordset.Update
Next
End If

If (oRepertoire.SubFolders.Count > 0) Then
For Each oDossier In oRepertoire.SubFolders
Call ListeFichier(oDossier)
Next
End If

End Sub
'
'==========================================================================
'
Function ChercheAttributs (ByVal oFichier,ByVal Validation, ByRef Reponse)

' On Error Resume Next

Reponse = "Aucun"

Select Case (Validation)
Case (LECTURE)
If (oFichier.Attributes AND 1) Then
Reponse = "Activer" 'Read-only = VRAI
Else
Reponse = "Désactiver" 'Read-only = FAUX
End If

Case (CACHE)
If (oFichier.Attributes AND 2) Then
Reponse = "Activer" 'Hidden file = VRAI
Else
Reponse = "Désactiver" 'Hidden file = FAUX
End If

Case (SYSTEME)
If (oFichier.Attributes AND 4) Then
Reponse = "Activer" 'System file = VRAI
Else
Reponse = "Désactiver" 'System file = FAUX
End If

Case (ARCHIVE)
If (oFichier.Attributes AND 32) Then
Reponse = "Activer" 'Archive bit = VRAI
Else
Reponse = "Désactiver" 'Archive bit = FAUX
End If
Case (RACCOURCI)
If (oFichier.Attributes AND 64) Then
Reponse = "Activer" 'ShortCut = VRAI
Else
Reponse = "Désactiver" 'ShortCut = FAUX
End If
Case (COMPRESSE)
If (oFichier.Attributes AND 2048) Then
Reponse = "Activer" 'Compressed file = VRAI
Else
Reponse = "Désactiver" 'Compressed file = FAUX
End If
Case Else Reponse = "Aucun"

End Select

End Function
'
'==========================================================================
'

Lupin

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
17 juin 2005 à 14:44

salut merci de t etre donné la peine de repondre c est gentil
j ai un petit probleme ton code est long est complexe un peu alors di mois si il etai possible de te contacter par mail diretcment pour te demander quelques explication

merci a bientot peut etre

Réponse 2 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
21 juin 2005 à 16:36

Voila MIster Lupin en faisant un copier coller du code ci dessous ya de l avancement mais j ai encore bloqué alors si tu peux debloquer la situation se serai cool merci

'----------------------------------------------------------
' Script de description des Hdd dans une page web
' ----------------------------------------------------------
'
'*************************************************************************
'Constante d'accèss au fichier *.mdb

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3

Const MoteurDeRecherche = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" '
' Déclaration des variables de la base de données ACCESS
'
Dim oFS, Disque, Fichier, AccesFichier

Dim objConnection
Dim objRecordset
'Dim AccesFichier
'*************************************************************************

'********-----------------------------------------------------************
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
DestHtml = "hd.html" '********-----------------------------------------------------************

Dim cnt
dim Aff()
dim Aff0()
dim Aff1()
dim Aff2()
dim Aff3()

cnt = 0
Redim Aff(cnt)
Redim Aff0(cnt)
Redim Aff1(cnt)
Redim Aff2(cnt)
Redim Aff3(cnt)

Select Case WScript.Arguments.Count
Case 0
' Default if none specified is local computer (".")
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputer = objItem.Name
Next
Case 1
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = Wscript.Arguments(0)
if InStr( strComputer, "?" ) > 0 Then Syntax
Case Else
' Maximum is 1 command line parameter
Syntax
End Select

Display (strComputer)
CreateHTML (DestHTML )
CreateBDAccess()

Function Display( strComputer )

On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err.Number Then
WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _
" " & Err.Description
Err.Clear
Syntax
End If
On Error GoTo 0
' Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where MediaType=12",,48)
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48)
For Each objItem in colItems
Aff(cnt) = strComputer
Aff0(cnt) = objItem.Name & vbTab
Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) )
Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) )
Aff3(cnt) = CStr( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & _
vbCrLf
cnt = cnt + 1
Redim Preserve Aff(cnt)
ReDim Preserve Aff0(cnt)
Redim Preserve Aff1(cnt)
Redim Preserve Aff2(cnt)
Redim Preserve Aff3(cnt)
Next
End Function

' ----------------------------------------------------------

Function CreateHTML(filename)
dim ts
set ts=fso.CreateTextFile(filename,true)

ts.writeline "<HTML>"
ts.WriteLine "<BODY>"
ts.WriteLine "<CENTER><H3>Affiche les informations des HDD</H3>"
ts.writeline "<table border=1 cellspacing=1 width=100%>"
ts.writeline "<tr>"
ts.writeline "<td width=20%>"
ts.writeline "Name</td>"
ts.writeline "<td width=20%>"
ts.writeline "Drive</td>"
ts.writeline "<td width=20%>"
ts.writeline "Size</td>"
ts.writeline "<td width=20%>"
ts.writeline "Free</td>"
ts.writeline "<td width=20%>"
ts.writeline "% Free</td>"
ts.writeline "</tr>"
ts.writeline "<tr>"
for i = 0 to cnt
ts.writeline "<td width=20%>" & Aff(i) & "</td>"
ts.writeline "<td width=20%>" & Aff0(i) & "</td>"
ts.writeline "<td width=20%>" & Aff1(i) & "</td>"
ts.writeline "<td width=20%>" & Aff2(i) & "</td>"
ts.writeline "<td width=20%>" & Aff3(i) & "</td>"
ts.writeline "</tr>"
next

ts.writeline "</table>"
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline "Fait le 14 juin 2005 par Mohax qui pète un plomb lol"
ts.WriteLine "</CENTER></BODY>"
ts.WriteLine "</HTML>"
ts.close
End Function

Function CreateBDAccess()

'Nom du fichier MSAccess
Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "F:\BdDisque.MDB")
'Établie un objet ADO pour déplacement dans objet
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
'Créer un objet fichier pour atteindre le fichier mdb
Set oFS = CreateObject("Scripting.FileSystemObject")
'Lecteur courant ?
Disque = Mid(Fichier, 1, 2)
'Capture du lecteur
Set oLecteur = oFS.GetDrive(Disque)
'Lecteur prêt ?
If (oLecteur.IsReady) Then
'Accroche le fichier sur le moteur de recherche
AccesFichier = MoteurDeRecherche & Fichier
'Ouverture du fichier access
objConnection.Open AccesFichier
'Création d'un ensemble "recordset" sur les données souhaité
objRecordset.Open "SELECT * FROM EspaceDisque" , objConnection, adOpenStatic, adLockOptimistic
End If

For i = 0 to cnt
objRecordset.AddNew

objRecordset("Champs1") = Aff(i)
objRecordset("Champs2") = Aff0(i)
objRecordset("Champs3") = Aff1(i)
objRecordset("Champs4") = Aff2(i)
objRecordset("Champs5") = Aff3(i)

objRecordset.Update
Next
End Function

Réponse 3 / 17

Utilisateur anonyme
17 juin 2005 à 15:09

Salut,

Bon, j'ai toujours du mal a laisser trainer une adresse courriel dans un forum, j'ai du par le passer détruire une adresse pour cause de spam. Enfin, tu peux m'écrire ici à pierre_charpentier2000 arobas yahoo point ca.

@+

random Messages postés 1612 Date d'inscription vendredi 26 novembre 2004 Statut Membre Dernière intervention 30 mars 2006 155
17 juin 2005 à 16:15

tu ne manques pas d'un courage certain

Lupin > random Messages postés 1612 Date d'inscription vendredi 26 novembre 2004 Statut Membre Dernière intervention 30 mars 2006
17 juin 2005 à 16:31

re:

celle-la est du pour être détruite de toute focon !

Lupin

Réponse 4 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
20 juin 2005 à 12:34

EN faites voici Mon scrupt Qui me permet de recuperer l espace restant de mes disque ! et jeveux que a chaque lancement de se script ca ma stock les données concernant les disque dans une base de donnée type ACESS.Alors est ce que qu un peu me dire comment envoyer ses données a ma base Merci d avnce a toutes et a tous!!!

'----------------------------------------------------------
' Script de description des Hdd dans une page web
' ----------------------------------------------------------
Dim cnt
dim Aff()
dim Aff0()
dim Aff1()
dim Aff2()
dim Aff3()

cnt = 0
Redim Aff(cnt)
Redim Aff0(cnt)
Redim Aff1(cnt)
Redim Aff2(cnt)
Redim Aff3(cnt)

Select Case WScript.Arguments.Count
Case 0
' Default if none specified is local computer (".")
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputer = objItem.Name
Next
Case 1
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = Wscript.Arguments(0)
if InStr( strComputer, "?" ) > 0 Then Syntax
Case Else
' Maximum is 1 command line parameter
Syntax
End Select

Display( strComputer )

Function Display( strComputer )
On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err.Number Then
WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _
" " & Err.Description
Err.Clear
Syntax
End If
On Error GoTo 0
' Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where MediaType=12",,48)
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48)
For Each objItem in colItems
Aff(cnt) = strComputer
Aff0(cnt) = objItem.Name & vbTab
Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) )
Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) )
Aff3(cnt) = CStr( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & _
vbCrLf
cnt = cnt + 1
Redim Preserve Aff(cnt)
Redim Preserve Aff0(cnt)
Redim Preserve Aff1(cnt)
Redim Preserve Aff2(cnt)
Redim Preserve Aff3(cnt)
Next
End Function

' ----------------------------------------------------------
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
DestHtml = "hd.html"
CreateHTML DestHTML

Sub CreateHTML(filename)
dim ts
set ts=fso.CreateTextFile(filename,true)
ts.writeline "<HTML>"
ts.WriteLine "<BODY>"
ts.WriteLine "<CENTER><H3>Affiche les informations des HDD</H3>"
ts.writeline "<table border=1 cellspacing=1 width=100%>"
ts.writeline "<tr>"
ts.writeline "<td width=20%>"
ts.writeline "Name</td>"
ts.writeline "<td width=20%>"
ts.writeline "Drive</td>"
ts.writeline "<td width=20%>"
ts.writeline "Size</td>"
ts.writeline "<td width=20%>"
ts.writeline "Free</td>"
ts.writeline "<td width=20%>"
ts.writeline "% Free</td>"
ts.writeline "</tr>"
ts.writeline "<tr>"
for i = 0 to cnt
ts.writeline "<td width=20%>" & Aff(i) & "</td>"
ts.writeline "<td width=20%>" & Aff0(i) & "</td>"
ts.writeline "<td width=20%>" & Aff1(i) & "</td>"
ts.writeline "<td width=20%>" & Aff2(i) & "</td>"
ts.writeline "<td width=20%>" & Aff3(i) & "</td>"
ts.writeline "</tr>"
next

ts.writeline "</table>"
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline "Fait le 14 juin 2005 par Mohax qui pète un plomb lol"
ts.WriteLine "</CENTER></BODY>"
ts.WriteLine "</HTML>"
ts.close
End Sub

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 17

Utilisateur anonyme
21 juin 2005 à 00:53

Bonjour,

Voilà, j'ai tenté de comprendre un peu ton code et j'ai adapté,
toutefois le compilateur me plante sur des lignes de ta partie,
alors je n'ai pu valider la partie que j'ai rajouté ...

'---------------------------------------------------------- 
' Script de description des Hdd dans une page web 
' ---------------------------------------------------------- 
'
'*************************************************************************
'Constante d'accèss au fichier *.mdb

Const adOpenStatic = 3 
Const adLockOptimistic = 3 
Const adUseClient = 3 

Const MoteurDeRecherche = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" 

' 
' Déclaration des variables de la base de données ACCESS 
' 
Dim oFS, Disque, Fichier, AccesFichier 

Dim objConnection 
Dim objRecordset 
Dim AccesFichier 
'*************************************************************************

'********-----------------------------------------------------************
Dim fso 
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 
DestHtml = "hd.html" 
'********-----------------------------------------------------************

Dim cnt 
dim Aff() 
dim Aff0() 
dim Aff1() 
dim Aff2() 
dim Aff3() 

cnt = 0 
Redim Aff(cnt) 
Redim Aff0(cnt) 
Redim Aff1(cnt) 
Redim Aff2(cnt) 
Redim Aff3(cnt) 
  
  Select Case WScript.Arguments.Count 
    Case 0 
        ' Default if none specified is local computer (".") 
        Set objWMIService = GetObject( "winmgmts://./root/cimv2" ) 
        Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 ) 
        For Each objItem in colItems 
          strComputer = objItem.Name 
        Next 
    Case 1 
        ' Command line parameter can either be a computer name 
        ' or "/?" to request online help 
        strComputer = Wscript.Arguments(0) 
        if InStr( strComputer, "?" ) > 0 Then Syntax 
    Case Else 
        ' Maximum is 1 command line parameter 
        Syntax 
  End Select 

  Display (strComputer) 
  CreateHTML (DestHTML )
  CreateBDAccess()
  
Function Display( strComputer ) 

  On Error Resume Next 
  Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" ) 
  If Err.Number Then 
    WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _ 
      " " & Err.Description 
    Err.Clear 
    Syntax 
  End If 
  On Error GoTo 0 
' Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where MediaType=12",,48) 
  Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48) 
  For Each objItem in colItems 
    Aff(cnt) = strComputer 
    Aff0(cnt) = objItem.Name & vbTab 
    Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) ) 
    Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) ) 
    Aff3(cnt) = CStr( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & _ 
    vbCrLf 
    cnt = cnt + 1 
    Redim Preserve Aff(cnt) 
    ReDim Preserve Aff0(cnt) 
    Redim Preserve Aff1(cnt) 
    Redim Preserve Aff2(cnt) 
    Redim Preserve Aff3(cnt) 
  Next 
End Function 

' ---------------------------------------------------------- 

Function CreateHTML(filename) 
  dim ts 
  set ts=fso.CreateTextFile(filename,true) 

  ts.writeline "<HTML>" 
  ts.WriteLine "<BODY>" 
  ts.WriteLine "<b><CENTER><H3>Affiche les informations des HDD</H3></b>" 
  ts.writeline "<table border=1 cellspacing=1 width=100%>" 
  ts.writeline "<tr>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Name</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Drive</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Size</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Free</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>% Free</b></td>" 
  ts.writeline "</tr>" 
  ts.writeline "<tr>" 

  for i = 0 to cnt 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff0(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff1(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff2(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff3(i) & "</font></b></td>" 
    ts.writeline "</tr>" 
  next 

  ts.writeline "</table>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<b><font size=2>Fait le 14 juin 2005 par Mohax qui pète un plomb lol</font></b>" 
  ts.WriteLine "</CENTER></BODY>" 
  ts.WriteLine "</HTML>" 
  ts.close
End Function

Function CreateBDAccess()

  'Nom du fichier MSAccess
  Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "C:\MaBase.MDB")
  'Établie un objet ADO pour déplacement dans objet
  Set objConnection = CreateObject("ADODB.Connection") 
  Set objRecordset = CreateObject("ADODB.Recordset") 
  'Créer un objet fichier pour atteindre le fichier mdb
  Set oFS = CreateObject("Scripting.FileSystemObject") 
  'Lecteur courant ?
  Disque = Mid(Fichier, 1, 2) 
  'Capture du lecteur
  Set oLecteur = oFS.GetDrive(Disque) 
  'Lecteur prêt ?
  If (oLecteur.IsReady) Then
    'Accroche le fichier sur le moteur de recherche
    AccesFichier = MoteurDeRecherche & Fichier
    'Ouverture du fichier access 
    objConnection.Open AccesFichier 
    'Création d'un ensemble "recordset" sur les données souhaité
    objRecordset.Open "SELECT * FROM MaTable" , objConnection, adOpenStatic, adLockOptimistic 
  End If

  For i = 0 to cnt 
    objRecordset.AddNew
    
    objRecordset("Champs1") = Aff(i)
    objRecordset("Champs2") = Aff0(i)
    objRecordset("Champs3") = Aff1(i)
    objRecordset("Champs4") = Aff2(i)
    objRecordset("Champs5") = Aff3(i)

    objRecordset.Update 
  Next 
End Function

Lupin

Réponse 6 / 17

Utilisateur anonyme
21 juin 2005 à 01:06

re:

le compilateur me plante sur les lignes ou l'instruction
CStr est localisé, je soupçonne un problème de typage :
Message : Utilisation non autorisée de Null: 'CStr'

mais pour le reste ça va, ton fichier mdb doit être créer avec
le bon nom de table et les bons noms de champs.

Réponse 7 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
21 juin 2005 à 09:49

Salut Mister Lupin et encore merci pour pour ton aide et desolé pour le derrangement occasioné!

Donc en faite je vois que en Vbscript tu va aussi Shumarer Moi j en suis encore au Karting comme tu as pu le voir looool!!!

En je voulais savoir si tu avais tester Mon code sans le modifier tu t es apercu qu il marchait rassure moi loool !!!

En faite Moi j ai crée une base de donnée Appelée BdDisque.mdb et dans cette base de donnée j ai crée une table que j ai nomé EspaceDisque et qui contient les champs suivants: Nom
Drive
Size
Free
Pourcentage
Date

Comme tu as pu l appercevoir cela correspond en faite aux données recuperées par mon script !! Ma base de Donnée se trouve dans mon disque F:\
Alors dis moi si ce que j ai fais est correcte deja dans un premier temps pour que je ne continu pas dans la n importe quoi lol

Moi quand je compile le script avec tes modifs j ai une erreur au niveau de la ligne 19 colonne 5 mais bon avec VBs Factory il te signale des erreurs a un endroit mais la faute est soit 10 ligne en dessous ou au dessus donc le compilateur n est pas de très bonne qualité c est ca qui me pose problem dans mon apprentissage de VBscript:

Réponse 8 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
21 juin 2005 à 14:28

je me suis appercu que dans ton script tu a defini 2 fois la variable suivante :

Dim oFS, Disque, Fichier, AccesFichier
Dim AccesFichier

tu vois que AccesFichier est defini deux fois et moi mon compilateur ma signal une erreur a se niveau !!!

Qu en pense Tu ? le problem peut venir de la je pense !!!

Réponse 9 / 17

Utilisateur anonyme
21 juin 2005 à 21:07

Salut Mister lameche,

je n'ai pas autant de temps que toi pour coder à ce que je vois,
toutefois, j'ai moi aussi rafiné le code ...

je vais regarder le tien mais en attendant, tu peux regarder
celui-ci, chez moi il vire impect :-)

et oui, effectivement tu verras que j'ai corrigé beaucoup de choses.
serait-ce "shumarrer" ?

'-------------------------------------------------------------------------
' Script de description des Hdd dans une page web et/ou une base Access
' ------------------------------------------------------------------------
'
'*************************************************************************
'Constante d'accèss au fichier *.mdb
'
Const adOpenStatic = 3 
Const adLockOptimistic = 3 
Const adUseClient = 3 
Const MoteurDeRecherche = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" 
' 
' Déclaration des variables de la base de données ACCESS 
' 
  Dim oFS, objConnection, objRecordset
'*************************************************************************
'
  Dim objWMIService, colItems, DestHtml 
  'Créer un objet fichier
  Set oFS = WScript.CreateObject("Scripting.FileSystemObject") 
'********-----------------------------------------------------************

  Dim cnt 
  Dim Aff() 
  Dim Aff0() 
  Dim Aff1() 
  Dim Aff2() 
  Dim Aff3() 

  cnt = 0 
  Redim Aff(cnt) 
  Redim Aff0(cnt) 
  Redim Aff1(cnt) 
  Redim Aff2(cnt) 
  Redim Aff3(cnt) 

  DestHtml = "hd.html" 
  
  Select Case WScript.Arguments.Count 
    Case 0 
        ' Default if none specified is local computer (".") 
        Set objWMIService = GetObject( "winmgmts://./root/cimv2" ) 
        Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 ) 
        For Each objItem in colItems 
          strComputer = objItem.Name 
        Next 
    Case 1 
        ' Command line parameter can either be a computer name 
        ' or "/?" to request online help 
        strComputer = Wscript.Arguments(0) 
        if InStr( strComputer, "?" ) > 0 Then Syntax 
    Case Else 
        ' Maximum is 1 command line parameter 
        Syntax 
  End Select 

  Display (strComputer) 
  CreateHTML (DestHTML )
  CreateBDAccess()
  
  Set objWMIService = Nothing
  Set colItems = Nothing
'
'**** Fin du script
  WScript.Quit
   

Function Display( strComputer ) 

  Dim objWMIServ, colonnesItem

  On Error Resume Next 
  Set objWMIServ = GetObject( "winmgmts://" & strComputer & "/root/cimv2" ) 
  If Err.Number Then 
    WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _ 
      " " & Err.Description 
    Err.Clear 
    Syntax 
  End If 
  
  On Error GoTo 0 
  Set colonnesItem = objWMIServ.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48) 
  
  For Each objItem in colonnesItem 
    Aff(cnt) = strComputer
    Aff0(cnt) = Mid(objItem.Name,1,1)
    If ( objItem.Size > 0 ) Then
      Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) )
    End If
    If (objItem.FreeSpace > 0) Then
      Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) ) 
    End If
    If ( (objItem.Size > 0) And (objItem.FreeSpace > 0) ) Then
      Aff3(cnt) = ( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & vbCrLf
    End If
    cnt = cnt + 1 
    Redim Preserve Aff(cnt) 
    ReDim Preserve Aff0(cnt) 
    Redim Preserve Aff1(cnt) 
    Redim Preserve Aff2(cnt) 
    Redim Preserve Aff3(cnt) 
  Next

  Set objWMIServ = Nothing
  Set colonnesItem = Nothing
  
End Function 

' ---------------------------------------------------------- 

Function CreateHTML(filename) 
  Dim ts 
  Set ts = oFS.CreateTextFile(filename,True) 

  ts.writeline "<HTML>" 
  ts.WriteLine "<BODY>" 
  ts.WriteLine "<b><CENTER><H3>Affiche les informations des HDD</H3></b>" 
  ts.writeline "<table border=1 cellspacing=1 width=100%>" 
  ts.writeline "<tr>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Name</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Drive</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Size</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>Free</b></td>" 
  ts.writeline "<td width=20%>" 
  ts.writeline "<p align=center><b>% Free</b></td>" 
  ts.writeline "</tr>" 
  ts.writeline "<tr>" 

  For i = 0 to cnt 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff0(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff1(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff2(i) & "</font></b></td>" 
    ts.writeline "<td width=20%><p align=center><b><font color=#FF0000>" & Aff3(i) & "</font></b></td>" 
    ts.writeline "</tr>" 
  Next 

  ts.writeline "</table>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<p> </p>" 
  ts.writeline "<b><font size=2>Remanier le 21 juin 2005 lol</font></b>" 
  ts.WriteLine "</CENTER></BODY>" 
  ts.WriteLine "</HTML>" 
  ts.close
  
  Set ts = Nothing
  
End Function

' ---------------------------------------------------------- 

Function CreateBDAccess()

  Dim Fichier, Disque, AccessFichier

  'Nom du fichier MSAccess
  Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "C:\MaBase.MDB")
  'Établie un objet ADO pour déplacement dans objet
  Set objConnection = CreateObject("ADODB.Connection") 
  Set objRecordset = CreateObject("ADODB.Recordset") 
  'Lecteur courant ?
  Disque = Mid(Fichier, 1, 2) 
  'Capture du lecteur
  Set oLecteur = oFS.GetDrive(Disque) 
  'Si lecteur prêt ?
  If (oLecteur.IsReady) Then
    'Si le fichier existe ?
    If (oFS.FileExists(Fichier)) Then
      'Accroche le fichier sur le moteur de recherche
      AccesFichier = MoteurDeRecherche & Fichier
      'Ouverture du fichier access 
      objConnection.Open AccesFichier 
      'Création d'un ensemble "recordset" sur toutes les données souhaitées
      objRecordset.Open "SELECT * FROM EspaceDisk" , objConnection, adOpenStatic, adLockOptimistic 
    End If
  End If

  For i = 0 To (cnt -1)
    objRecordset.AddNew
    
    objRecordset("Ordinateur") = Aff(i)
    objRecordset("Lecteur") = Aff0(i)
    objRecordset("Grandeur") = Aff1(i)
    objRecordset("Disponible") = Aff2(i)
    objRecordset("Ratio") = Aff3(i)

    objRecordset.Update 
  Next
  
  objConnection.Close
  
  Set objConnection = Nothing
  Set objRecordset = Nothing
  Set oFS = Nothing
  Set oLecteur = Nothing
    
End Function

Je crois qu'il n'y as pas de mauvaise manière, il suffit d'obtenir
le bon résultat, l'erreur que j'avais occure lorsque l'une des partitions d'un disque quelconque n'est pas formatté. Or c'est
pour cela que j'ai rajouté un contrôle sur la lecture.

Il y a encore du travail, mais ça tient la route :-)

Lupin

Réponse 10 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
22 juin 2005 à 09:19

En faite avec le code ci dessus ca creer Une nouvelle Base de donnée si j ai bien compris biensur desolé je debute lool

En faite MOi ma base est deja creé sous Access elle est Nommé "BdDisque" avec une Table Applée "EspaceDisque" ET qui contient les champs suivants:
"Nom"
"Drive"
"Size"
"Free"
"Pourcentage"
"Date "
Moi je souhaite UNIQUEMENT ENVOYER LES DONNEES RENVOYe PAR MON SCRIPT dans ma base de données que j ai deja creé sur Access . Il faut que a chaque lancement du script les données soit memorise dans cette base voila
ALors si Lupin ou quelqu un pouvait m aider se serais sympa merci
voici mon script qui fonctionne deja pour la recuperation des données:

'----------------------------------------------------------
' Script de description des Hdd dans une page web
' ----------------------------------------------------------
Dim cnt
dim Aff()
dim Aff0()
dim Aff1()
dim Aff2()
dim Aff3()

cnt = 0
Redim Aff(cnt)
Redim Aff0(cnt)
Redim Aff1(cnt)
Redim Aff2(cnt)
Redim Aff3(cnt)

Select Case WScript.Arguments.Count
Case 0
' Default if none specified is local computer (".")
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputer = objItem.Name
Next
Case 1
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = Wscript.Arguments(0)
if InStr( strComputer, "?" ) > 0 Then Syntax
Case Else
' Maximum is 1 command line parameter
Syntax
End Select

Display( strComputer )

Function Display( strComputer )
On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err.Number Then
WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _
" " & Err.Description
Err.Clear
Syntax
End If
On Error GoTo 0
' Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where MediaType=12",,48)
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48)
For Each objItem in colItems
Aff(cnt) = strComputer
Aff0(cnt) = objItem.Name & vbTab
Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) )
Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) )
Aff3(cnt) = CStr( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & _
vbCrLf
cnt = cnt + 1
Redim Preserve Aff(cnt)
Redim Preserve Aff0(cnt)
Redim Preserve Aff1(cnt)
Redim Preserve Aff2(cnt)
Redim Preserve Aff3(cnt)
Next
End Function

' ----------------------------------------------------------
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
DestHtml = "hd.html"
CreateHTML DestHTML

Sub CreateHTML(filename)
dim ts
set ts=fso.CreateTextFile(filename,true)
ts.writeline "<HTML>"
ts.WriteLine "<BODY>"
ts.WriteLine "<CENTER><H3>Affiche les informations des HDD</H3>"
ts.writeline "<table border=1 cellspacing=1 width=100%>"
ts.writeline "<tr>"
ts.writeline "<td width=20%>"
ts.writeline "Name</td>"
ts.writeline "<td width=20%>"
ts.writeline "Drive</td>"
ts.writeline "<td width=20%>"
ts.writeline "Size</td>"
ts.writeline "<td width=20%>"
ts.writeline "Free</td>"
ts.writeline "<td width=20%>"
ts.writeline "% Free</td>"
ts.writeline "</tr>"
ts.writeline "<tr>"
for i = 0 to cnt
ts.writeline "<td width=20%>" & Aff(i) & "</td>"
ts.writeline "<td width=20%>" & Aff0(i) & "</td>"
ts.writeline "<td width=20%>" & Aff1(i) & "</td>"
ts.writeline "<td width=20%>" & Aff2(i) & "</td>"
ts.writeline "<td width=20%>" & Aff3(i) & "</td>"
ts.writeline "</tr>"
next

ts.writeline "</table>"
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline "Fait le 14 juin 2005 par Mohax qui pète un plomb lol"
ts.WriteLine "</CENTER></BODY>"
ts.WriteLine "</HTML>"
ts.close
End Sub

Réponse 11 / 17

Utilisateur anonyme
23 juin 2005 à 02:10

Salut,

bon, je ne vais pas tout recopier tout le code encore ...

Pour adresser le fichier, dans l'énoncé de mon message précédent,
[ligne 170], il faut modifier l'instruction suivante :

Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "C:\MaBase.MDB")

par la ligne suivante :

Fichier="C:\BdDisque.mdb"

et pour adresser la table, il faut modifier l'instruction suivante:
[ligne 187]

objRecordset.Open "SELECT * FROM EspaceDisk" , objConnection, adOpenStatic, adLockOptimistic

par la ligne suivante:

objRecordset.Open "SELECT * FROM EspaceDisque" , objConnection, adOpenStatic, adLockOptimistic

et enfin pour adresser les champs, il faut modifier les lignes :
[lignes 194-198]

objRecordset("Ordinateur") = Aff(i)
objRecordset("Lecteur") = Aff0(i)
objRecordset("Grandeur") = Aff1(i)
objRecordset("Disponible") = Aff2(i)
objRecordset("Ratio") = Aff3(i)

pour

objRecordset("Nom") = Aff(i)
objRecordset("Drive") = Aff0(i)
objRecordset("Size") = Aff1(i)
objRecordset("Free") = Aff2(i)
objRecordset("Pourcentage") = Aff3(i)
objRecordset("Date") = Date()

et tu auras exactement ce que tu cherche !!!

Lupin

Réponse 12 / 17

lameche007 Messages postés 20 Date d'inscription dimanche 22 août 2004 Statut Membre Dernière intervention 12 août 2005 6
27 juin 2005 à 11:57

salut sHUMI VOILA ENFIN LE SCRIPT QUI MARCHE NIKEL EN FAITE J AVAIS UN PROBLEME SUR MA BECANE AVEC Mes Sources ODBC!!

donc le script suivant permet de repertorier les disque ainsi que l espace libre d une part il donne le resukta sur un page web puis il stock le tous dans une BD Access qu il faut avoir crée eu préalable ca prend 2 minute lool!!

Voila en faite j ai essayé de detail pour les gens qui debutent comme moi parceque je crois que c est eux qui ont le plus besoin d aide !!

merci au gens comme lupin et les autre qui prenne le temps de donner un coup de main:

'-------------------------------------------------------------------------
' Script de description des Hdd dans une page web et/ou une base Access
' ------------------------------------------------------------------------
'
'*************************************************************************
'Constante d'accèss au fichier *.mdb
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Const MoteurDeRecherche ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

'"Provider=Microsoft.Jet.OLEDB.4.0;Data Source= C:\BdDisque.mdb;"

' Déclaration des variables de la base de données ACCESS
'
Dim oFS, objConnection, objRecordset
'*************************************************************************
'
Dim objWMIService, colItems, DestHtml
'Créer un objet fichier
Set oFS = WScript.CreateObject("Scripting.FileSystemObject")
'********-----------------------------------------------------************

Dim cnt
Dim Aff()
Dim Aff0()
Dim Aff1()
Dim Aff2()
Dim Aff3()

cnt = 0
Redim Aff(cnt)
Redim Aff0(cnt)
Redim Aff1(cnt)
Redim Aff2(cnt)
Redim Aff3(cnt)

DestHtml = "hd.html"
Select Case WScript.Arguments.Count
Case 0
' Default if none specified is local computer (".")
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputer = objItem.Name
Next
Case 1
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = Wscript.Arguments(0)
if InStr( strComputer, "?" ) > 0 Then Syntax
Case Else
' Maximum is 1 command line parameter
Syntax
End Select

Display (strComputer)
CreateHTML (DestHTML )
CreateBDAccess()

Set objWMIService = Nothing
Set colItems = Nothing
'
'**** Fin du script
WScript.Quit

Function Display( strComputer )

Dim objWMIServ, colonnesItem

On Error Resume Next
Set objWMIServ = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
If Err.Number Then
WScript.Echo vbCrLf & "Error # " & CStr( Err.Number ) & _
" " & Err.Description
Err.Clear
Syntax
End If

On Error GoTo 0
Set colonnesItem = objWMIServ.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3",,48)

For Each objItem in colonnesItem
Aff(cnt) = strComputer
Aff0(cnt) = Mid(objItem.Name,1,1)
If ( objItem.Size > 0 ) Then
Aff1(cnt) = CStr( Int( 0.5 + ( objItem.Size / 1073741824 ) ) )
End If
If (objItem.FreeSpace > 0) Then
Aff2(cnt) = CStr( Int( 0.5 + ( objItem.FreeSpace / 1073741824 ) ) )
End If
If ( (objItem.Size > 0) And (objItem.FreeSpace > 0) ) Then
Aff3(cnt) = ( Int( 0.5 + ( 100 * objItem.FreeSpace / objItem.Size) ) ) & vbCrLf
End If
cnt = cnt + 1
Redim Preserve Aff(cnt)
ReDim Preserve Aff0(cnt)
Redim Preserve Aff1(cnt)
Redim Preserve Aff2(cnt)
Redim Preserve Aff3(cnt)
Next

Set objWMIServ = Nothing
Set colonnesItem = Nothing

End Function

' ----------------------------------------------------------

Function CreateHTML(filename)
Dim ts
Set ts = oFS.CreateTextFile(filename,True)

ts.writeline "<HTML>"
ts.WriteLine "<BODY>"
ts.WriteLine "<CENTER><H3>Affiche les informations des HDD</H3>"
ts.writeline "<table border=1 cellspacing=1 width=100%>"
ts.writeline "<tr>"
ts.writeline "<td width=20%>"
ts.writeline "Name</td>"
ts.writeline "<td width=20%>"
ts.writeline "Drive</td>"
ts.writeline "<td width=20%>"
ts.writeline "Size</td>"
ts.writeline "<td width=20%>"
ts.writeline "Free</td>"
ts.writeline "<td width=20%>"
ts.writeline "% Free</td>"
ts.writeline "</tr>"
ts.writeline "<tr>"
For i = 0 to cnt
ts.writeline "<td width=20%>" & Aff(i) & "</td>"
ts.writeline "<td width=20%>" & Aff0(i) & "</td>"
ts.writeline "<td width=20%>" & Aff1(i) & "</td>"
ts.writeline "<td width=20%>" & Aff2(i) & "</td>"
ts.writeline "<td width=20%>" & Aff3(i) & "</td>"
ts.writeline "</tr>"
Next

ts.writeline "</table>"
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline " "
ts.writeline "Remanier le 21 juin 2005 lol"
ts.WriteLine "</CENTER></BODY>"
ts.WriteLine "</HTML>"
ts.close

Set ts = Nothing

End Function

' ----------------------------------------------------------

Function CreateBDAccess()

Dim Fichier, Disque, AccessFichier

'Nom du fichier MSAccess
'Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "C:\MaBase.MDB")
Fichier="BdDisque.mdb"
'Établie un objet ADO pour déplacement dans objet
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
'Lecteur courant ?
Disque = Mid(Fichier, 1, 2)
'Capture du lecteur
Set oLecteur = oFS.GetDrive("C:")
'Si lecteur prêt ?
If (oLecteur.IsReady) Then
'msgbox Fichier
'Si le fichier existe ?
If (oFS.FileExists(Fichier)) Then
'msgbox "toto"
'Accroche le fichier sur le moteur de recherche
AccesFichier = MoteurDeRecherche & Fichier
'Ouverture du fichier access

'msgbox AccesFichier
ObjConnection.Open AccesFichier
wscript.echo err

'Création d'un ensemble "recordset" sur toutes les données souhaitées
objRecordset.Open "SELECT * FROM EspaceDisque" , objConnection, adOpenStatic, adLockOptimistic
End If
End If

For i = 0 To (cnt -1)
objRecordset.AddNew
objRecordset("Nom") = Aff(i)
objRecordset("Drive") = Aff0(i)
objRecordset("Size") = Aff1(i)
objRecordset("Free") = Aff2(i)
objRecordset("Pourcentage") = Aff3(i)
objRecordset("Date") = Date()

objRecordset.Update
Next

objConnection.Close

Set objConnection = Nothing
Set objRecordset = Nothing
Set oFS = Nothing
Set oLecteur = Nothing

End Function

Réponse 13 / 17

derbali asma
23 déc. 2006 à 11:44

commande de vb script

Réponse 14 / 17

Utilisateur anonyme
23 déc. 2006 à 15:01

Bonjour,

L'honorable M. Bellamy m'a apprit beaucoup, c'est en quelque
sorte un mentor pour moi.

Merci Jean-Claude.
http://www6.bellamyjc.org/?tdfs=1&kw=Computer+Software+Blog&term=Computer%20Knowledge%20Base%20Software&term=Windows%20Server%20Patch%20Management%20Software&term=Windows%20Server%20Backup%20Software&backfill=0

Lupin

Réponse 15 / 17

Alexandre
1 juin 2007 à 14:16

Bonjour a tous j'espere qu'il y aura quelqu'un car moi je cherche a automatiser via un script des données vers access.
Ce sont des données venant de NetworkView que je souhaite integrer dans ma base de registre access via un script d'automatisation.
Le code me parait assez similaire cependant il me manque encore quelques info pouvez vous m'orientez svp?

Réponse 16 / 17

Alexandre
4 juin 2007 à 08:32

Quelqu'un pourrais m'aider a faire la meme chose mais depuis les données de netwokview svp?

Réponse 17 / 17

stéphane
23 mai 2008 à 09:46

comment envoyé les bit (signaux )sur le port via le grafpiou

Discussions similaires

exemple base de données Access de gestion

Besoin base de donnee access gestion stock

TNT base de donnees vide!!

mon téléphone ne reconnait plus sa base

Exemple de base de données access