VB腳本excel

我是一個服務檯技術在我的公司，我正在嘗試創建一個vb登錄腳本，收集有關用戶和計算機的各種信息，並創建或修改網絡驅動器上的excel電子表格。關於編程的背景，我不是程序員。我的知識是有限的，但我理解一些編程邏輯。到目前爲止，我已經能夠將科學怪人的腳本與各種來源在線連接起來，甚至還有一些我自己的編程。這是我的絆腳石。我希望將用戶的所有網絡驅動器都列入Excel中的單個單元。我試過一切都沒有成功。
我能得到的最接近的是它只列出了一個（最後一個）網絡驅動器。我遇到的另一個問題是它不會列出AD的任何我的團隊成員。我知道我是一個超級新手，但我願意學習和理解。任何幫助將是偉大的！這裏是我的代碼：VB腳本excel

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

來源

2013-08-19 stubbypook

對VBScript進行故障排除的第一步：刪除'On Error Resume Next'並找出你得到的實際錯誤。此外，請解釋您所嘗試的內容以及結果與預期的不同之處。 –

我不打算通過您的代碼來工作，所以我將集中討論的問題是：

我想所有的用戶的網絡驅動器的列表，以excel內的單個單元格。

你會使用字符串連接與符號&操作：

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

替換爲「C：」與任何變量包含當前驅動器盤符。

來源

2013-08-19 21:04:47

爲了解決這個問題，驅動器（沒有前導空格）：

>> 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 & """"

認沽sDrives進入細胞（一次）。

來源

2013-08-19 21:10:00

回答

相關問題