Scripting VB pour excel

Je suis un bureau d'assistance technique chez moi et j'essaie de créer un script de connection vb qui rassemblerait diverses choses sur l'user et l'ordinateur et créerait ou modifierait une feuille Excel diffusée sur un lecteur réseau. Un peu de mes antécédents avec la programmation, je ne suis pas un programmeur. Ma connaissance est limitée, mais je comprends une certaine logique de programmation. Jusqu'à présent, Frankenstein a réuni ce script vbs de diverses sources en ligne même avec certaines de mes propres émissions. Voici mon arrêt. Je souhaite énumérer tous les lecteurs réseau d'un user sur une cellule unique dans Excel. J'ai tout essayé sans succès.
Le plus proche que je puisse get est qu'il ne répertorie qu'un seul (le dernier) lecteur réseau. L'autre problème que j'ai eu, c'est qu'il ne répertorie aucun de mes membres de groupes AD. Je sais que je suis un super novice mais je suis prêt à apprendre et à comprendre. Toute aide est la bienvenue! Voici mon code:

Set WshShell = WScript.CreateObject("wscript.shell") Set objArgs = WScript.Arguments Set fso = CreateObject("Scripting.FileSystemObject") Set oShell = CreateObject("wscript.Shell") Set env = oShell.environment("Process") strComputer = env.Item("Computername") Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True Set objWorkbook = objExcel.Workbooks.Add() Set objWorksheet = objWorkbook.Worksheets(1) objExcel.worksheets(2).delete objExcel.worksheets(2).delete objExcel.ActiveWorkbook.Windows(1).Caption = OutputFile strOut = "" getOSInfo Sub getOSInfo() On Error Resume Next objExcel.worksheets(1).Activate objExcel.worksheets(1).Name = "Computer Info" objExcel.Cells(1, 1).Value = "Computer Name" objExcel.Cells(2, 1).Value = "Computer Name from system" objExcel.Cells(3, 1).Value = "IP(s) from system" objExcel.Cells(4, 1).Value = "Logon Name" objExcel.Cells(5, 1).Value = "Operating System" objExcel.Cells(6, 1).Value = "Last Bootup Time" objExcel.Cells(7, 1).Value = "Install Date" objExcel.Cells(8, 1).Value = "Manufacturer" objExcel.Cells(9, 1).Value = "Serial Number" objExcel.Cells(10, 1).Value = "Model" objExcel.Cells(11, 1).Value = "Mapped Drives" objExcel.Cells(12, 1).Value = "Member of Group(s)" objExcel.Cells(13, 1).Value = "Amt. of Storage Allocated" objExcel.Cells(14, 1).Value = "# of Processors" objExcel.Cells(15, 1).Value = "Processor Type" objExcel.Cells(16, 1).Value = "Memory (GB)" colVar=2 Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") If Err.Number <> 0 Then objExcel.Cells(1, colVar).Value = strComputer objExcel.Cells(2, colVar).Value = "Error # " & CStr(Err.Number) & " " & Err.Description printout "Error # " & CStr(Err.Number) & " " & Err.Description colVar = colVar+1 Err.Clear Else objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_OperatingSystem for " & strComputer Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem") objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_BIOS for " & strComputer Set colBIOS = objWMIService.ExecQuery ("Select * from Win32_BIOS") objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_ComputerSystem for " & strComputer Set colComputerSystem = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem") objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_NetworkAdapterConfiguration for " & strComputer Set colNetworkAdapterConfiguration = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration") objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_MappedLogicalDisk for " & strComputer Set objNetwork = WScript.CreateObject("WScript.Network") objExcel.ActiveWorkbook.Windows(1).Caption = "Getting Win32_Processor info for " & strComputer Set colProc = objWMIService.ExecQuery("Select * from Win32_Processor") For Each objOS In colOperatingSystems objExcel.ActiveWorkbook.Windows(1).Caption = "Setting Computer Name for " & strComputer objExcel.Cells(1, colVar).Value = strComputer objExcel.ActiveWorkbook.Windows(1).Caption = "Setting Last Boot Time for " & strComputer Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime") dtmConvertedDate.Value = objOS.InstallDate dtmInstallDate = dtmConvertedDate.GetVarDate objExcel.Cells(7, colVar).Value = dtmInstallDate tempArray = Split(objOS.name, "|") objExcel.Cells(6, colVar).Value = tempArray(0) dtmConvertedDate.Value = objOS.LastBootUpTime dtmBootTime = dtmConvertedDate.GetVarDate objExcel.Cells(5, colVar).Value = dtmBootTime Next For Each objBIOS In colBIOS objExcel.ActiveWorkbook.Windows(1).Caption = "Setting BIOS info for " & strComputer objExcel.Cells(9, colVar).Value = objBIOS.SerialNumber Next For Each objCS In colComputerSystem objExcel.ActiveWorkbook.Windows(1).Caption = "Setting Manufacturer info for " & strComputer objExcel.Cells(8, colVar).Value = objCS.Manufacturer objExcel.ActiveWorkbook.Windows(1).Caption = "Setting Model info for " & strComputer objExcel.Cells(10, colVar).Value = objCS.Model objExcel.ActiveWorkbook.Windows(1).Caption = "Setting name from WMI for " & strComputer objExcel.Cells(2, colVar).Value = objCS.name objExcel.ActiveWorkbook.Windows(1).Caption = "Setting Total Physical Memory for " & strComputer objExcel.Cells(16, colVar).Value = Round(objCS.TotalPhysicalMemory/1024/1024/1024,2) Next For Each objNetAdapter In colNetworkAdapterConfiguration objExcel.ActiveWorkbook.Windows(1).Caption = "Getting IP Addresses for " & strComputer ipAddress = objNetAdapter.ipaddress For i = 0 To UBound(ipaddress) If iplist = "" Then iplist = ipaddress(i) Else iplist = iplist & ", " & ipaddress(i) End If Next objExcel.Cells(3, colVar).Value = iplist Next Set colDrives = objNetwork.EnumNetworkDrives For i = 0 to colDrives.Count-1 Step 2 objExcel.Cells(11, colVar).Value = colDrives.Item(i) & vbTab & colDrives.Item (i + 1) Next Err.Clear strUser = strComputer & "$" objExcel.ActiveWorkbook.Windows(1).Caption = "Getting AD Group info for " & strComputer Set objRoot = GetObject("LDAP://RootDSE") defaultNC = objRoot.Get("defaultnamingcontext") computerDN = FindUser(strUser, defaultNC) ouarray = Split(computerDN,",") For i = 1 To UBound(ouarray) If ou = "" Then ou = ouarray(i) Else ou = ou & "," & ouarray(i) End If Next Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMI.ExecQuery("Select * from Win32_ComputerSystem") For Each objItem In colItems strUsers = objItem.UserName Next objExcel.Cells(4, colVar).Value = strUsers 'ou Set dicSeenGroup = CreateObject("Scripting.Dictionary") strGroups = DisplayGroups(computerDN,"",dicSeenGroup) aryGroups = Split(strGroups,"CN=") strGroups = "" For i = 2 To UBound(aryGroups) strGroups = strGroups & ", " & aryGroups(i) Next objExcel.Cells(12, colVar).Value = Right(strGroups,Len(strGroups) -2) Err.Clear stroutput = getDriveLettersAndSize(strComputer) objExcel.Cells(13, colVar).Value = Left(stroutput,Len(stroutput)-2) ProcCount = 0 objExcel.ActiveWorkbook.Windows(1).Caption = "Setting number of processors for " & strComputer For Each processor In colProc ProcCount = ProcCount + 1 ProcName = processor.name Next objExcel.Cells(14, colVar).Value = ProcCount objExcel.Cells(15, colVar).Value = Trim(ProcName) strOut = "" iplist = "" ou = "" colVar = colVar+1 End If objExcel.Cells.Select objExcel.Cells.EntireColumn.AutoFit objExcel.Range("B2").Select objExcel.ActiveWindow.FreezePanes = True objWorksheet.Columns("B:B").HorizontalAlignment = -4131 objExcel.ActiveWorkbook.Windows(1).Caption = "Finished gathering computer info" End Sub Function FindUser(Byval UserName, Byval Domain) On Error Resume Next Set cn = CreateObject("ADODB.Connection") Set cmd = CreateObject("ADODB.Command") Set rs = CreateObject("ADODB.Recordset") cn.open "Provider=ADsDSOObject;" cmd.activeconnection=cn cmd.commandtext="SELECT ADsPath FROM 'LDAP://" & Domain & "' WHERE sAMAccountName = '" & UserName & "'" Set rs = cmd.Execute If Err<>0 Then FindUser="Error connecting to Active Directory Database:" & Err.description 'wscript.quit Else If Not rs.BOF And Not rs.EOF Then rs.MoveFirst FindUser = rs(0) Else FindUser = "Not Found" End If End If cn.close End Function Function DisplayGroups ( strObjectADsPath, strSpaces, dicSeenGroup) Set objObject = GetObject(strObjectADsPath) 'strOut must be global variable strOut = strOut & strSpaces & objObject.Name On Error Resume Next ' Doing this to avoid an error when memberOf is empty If IsArray( objObject.Get("memberOf") ) Then colGroups = objObject.Get("memberOf") Else colGroups = Array( objObject.Get("memberOf") ) End If For Each strGroupDN In colGroups If Not dicSeenGroup.Exists(strGroupDN) Then dicSeenGroup.Add strGroupDN, 1 DisplayGroups "LDAP://" & strGroupDN, strSpaces & " ", dicSeenGroup End If Next Err.Clear DisplayGroups = strOut End Function Function getDriveLettersAndSize(strComputer) On Error Resume Next Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2") If Err.Number Then getDriveLettersAndSize = "Error # " & CStr(Err.Number) & " " & Err.Description & " " Err.Clear Else On Error Goto 0 Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3", , 48) For Each objItem In colItems getDriveLettersAndSize = getDriveLettersAndSize & objItem.Name & " " & Round(getDriveSizeTotal(strComputer,objItem.Name)/1024/1024/1024,2) & "GB, " Next End If End Function Function getDriveSizeTotal(strComputer, drvLetter) On Error Resume Next Set objWMIService = GetObject("winmgmts://" & strComputer & "/root/cimv2") strTemp = strComputer If Err.Number Then getDriveSizeTotal = "0" Err.Clear Else On Error Goto 0 Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk where DriveType=3", , 48) For Each objItem In colItems If UCase(objItem.Name) = UCase(drvLetter) Then getDriveSizeTotal = objItem.Size End If Next End If End Function

Je n'ai pas l'intention de travailler à travers votre code afin que je me concentre sur la question:

Je souhaite énumérer tous les lecteurs réseau d'un user sur une cellule unique dans Excel.

Vous utiliserez la concaténation de string avec l'application et l'opérateur:

 Range("A1").Value = Range("A1").Value & " " & "C:"

Remplacez "C:" par n'importe quelle variable contenant la lettre de lecteur actuelle.

Pour résoudre le problème des lecteurs (sans un blank avant):

 >> Set objNetwork = WScript.CreateObject("WScript.Network") >> Set colDrives = objNetwork.EnumNetworkDrives >> sDrives = "" >> For i = 0 to colDrives.Count-1 Step 2 >> sDrives = sDrives & vbTab & colDrives.Item(i) >> Next >> sDrives = Mid(sDrives, 2) >> WScript.Echo """" & sDrives & """"

Placez sDrives dans la cellule (une fois).