[Option Explicit
'On Error Resume Next
 
Dim strUserName 'le nom de l'utilisateur débarrassé du nom de domaine
Dim colComputerInfosUsername '
Dim objComputerInfosUserName '
Dim objUserName ' nom d'utilisateur récupéré par wmi
Dim objComputerInfos ' un des objets contenu dans la requête faite sur le wmi
Dim colComputerInfos ' résultat brut de la requete faite sur le wmi
Dim strDirectory 'nom du répertoire  
Dim strFile   'nom du fichier
Dim strslash  'isole le /
Dim strCore   'le corps du nom du fichier
Dim strExt   'extension du fichier
Dim objFSO   'obj permettant l'accès au système de fichier
Dim objFolder  'Objet répertoire
Dim objShell  
Dim objTextFile
Dim objFile
Dim strPos
Dim colNetworkShares 'Collection contenant les partages mappés sur un pc
Dim objNetworkShares 'un object dans cette collection
Dim colNetworkinfos 'collections contenant les informations IP
Dim objNetworkinfos 'Un objet dans la collection
Dim strIpAddress 'adress IP
DIM strHostname
Dim strDomain
Dim strLetter
Dim strShare
Dim strIP
 
const ForReading = 1
const ForWriting = 2
const ForAppending = 8
 
Sub GetUserName 'fonction de récupération du nom d'utilisateur sans le domaine
 set colComputerInfosUserName=GetObject("winmgmts:" ).ExecQuery("Select name,Domain,UserName from win32_ComputerSystem" )
 
 For Each objComputerInfosUserName in colComputerInfosUserName
  objUserName=objComputerInfosUserName.UserName
 Next
End Sub
 
Sub DelDPUserName
 strpos = InStr(1, objUserName, "\" )
 strUserName = Mid(objUserName, strpos + 1)
End Sub
 
Sub CreateFile 'création du répertoire utilisé pour l'inventaire et s'il existe déjà on s'y connecte
 
strDirectory = "Q:\inventaire"
strslash="\"
strCore = strUserName
strExt=".txt"
strFile = "\" & strCore & ".txt"
wscript.Echo strUserName
 
Set objFSO=CreateObject("Scripting.FileSystemObject" )
 
 If objFSO.FolderExists(strDirectory) Then
  Set ObjFolder=objFSO.GetFolder(strDirectory)
 Else
  Set objFolder=objFSO.CreateFolder(strDirectory)
 End If
 
 If objFSO.FileExists(strDirectory&strFile) Then
  set objFolder=objFSO.GetFolder(strDirectory)
 Else
  set objFile=objFSO.CreateTextFile(strDirectory&strFile)
 End if
End Sub
 
GetUserName
DelDPUserName
CreateFile
 
wscript.sleep 15000
 
Set objTextFile=objFSO.OpenTextFile(strDirectory&strFile, ForAppending, True)
 
'On commence par récupérer les infos propres au pc. Nom, Domaine et Utilisateur Logué
set colComputerInfos =_
 GetObject("winmgmts:" ).ExecQuery("select name,Domain,Username from Win32_ComputerSystem" )
 
'On affiche les infos récoltées
'Set objTextFile=objFSO.OpenTextFile(strDirectory&strFile, ForAppending, True)
 
 
For Each objComputerInfos in colComputerInfos
 ObjTextFile.WriteLine(strUserName & ";Hostname: ;" & objComputerInfos.name)
 ObjTextFile.WriteLine(strUserName & ";Domain: ;" & objComputerInfos.Domain)
 ObjTextFile.WriteLine(strUserName & ";UserName: ;" & objComputerInfos.UserName)
Next
 
'Récolte des partages montés sur la machines, Lettre, partage et nom d'utilisateur utilisé
 
Set colNetworkShares=_
 GetObject("winmgmts:" ).ExecQuery("select LocalName,RemoteName,UserName from Win32_NetworkConnection" )
 
'récupération du résultat.
 
For Each objNetworkShares in colNetworkShares
 ObjTextFile.WriteLine(strUserName & ";Letter: ;" & objNetworkShares.LocalName & ";Share: ;" & objNetworkShares.RemoteName & ";UserName: ;" & objNetworkShares.UserName)
' ObjTextFile.WriteLine(strUserName & ";Share: ;" & objNetworkShares.RemoteName)
' ObjTextFile.WriteLine(strUserName & ";UserName: ;" & objNetworkShares.UserName)
Next
 
' Récolte de l'adresse IP et de la Mac Adresse de la carte réseau qui en possède une
 
 set colNetworkinfos=GetObject("winmgmts:" ).ExecQuery("Select Index,MACAddress,IPAddress from win32_NetworkAdapterConfiguration where IpEnabled=true" )
 
 For Each objNetworkInfos in colNetworkInfos
   For Each strIpAddress in objNetworkInfos.IPAddress
   ObjTextFile.WriteLine (strUserName & ";IP: ;" & strIPAddress & ";MAC: ;" & objNetworkInfos.MACAddress)
'   ObjTextFile.WriteLine("MAC: " & objNetworkInfos.MACAddress)
   Next
   
 Next

Script: inventaire.vbs
Ligne: 85
caract: 1
Erreur: Permission Denied
code: 800A0046

Set objTextFile=objFSO.OpenTextFile(strDirectory&strFile, ForAppending, True)

wscript.sleep 15000

Sub CreateFile 'création du répertoire utilisé pour l'inventaire et s'il existe déjà on s'y connecte
 

strDirectory = "Q:\inventaire"
strslash="\"
strCore = strUserName
strExt=".txt"
strFile = "\" & strCore & ".txt"
wscript.Echo strUserName
 

Set objFSO=CreateObject("Scripting.FileSystemObject" )
 

If objFSO.FolderExists(strDirectory) Then
  Set ObjFolder=objFSO.GetFolder(strDirectory)
 Else
  Set objFolder=objFSO.CreateFolder(strDirectory)
 End If
 

If objFSO.FileExists(strDirectory&strFile) Then
  set objFolder=objFSO.GetFolder(strDirectory)
 Else
  set objFile=objFSO.CreateTextFile(strDirectory&strFile)
 End if

set objFile = nothing
set objFolder = nothing

End Sub