excel - VB脚本到Excel

Question

我是我公司的技术支持人员，我正在尝试创建一个 vb 登录脚本，该脚本将收集有关用户和计算机的各种信息，并在网络驱动器上创建或修改 Excel 电子表格。关于我的编程背景，我不是程序员。我的知识有限，但我确实了解一些编程逻辑。到目前为止，我已经能够将来自各种在线来源的这个 vbs 脚本与我自己的一些编程结合在一起。这是我的障碍。我想将用户的所有网络驱动器列出到 excel 中的单个单元格中。我已经尝试了一切都没有成功。
我能得到的最接近的是它只列出一个（最后一个）网络驱动器。我遇到的另一个问题是它不会列出我在 AD 中的任何组成员。我知道我是一个超级新手，但我愿意学习和理解。任何帮助都会很棒！这是我的代码：

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

Answer 1

我不打算通过你的代码工作，所以我将专注于这个问题：

我想将用户的所有网络驱动器列出到 excel 中的单个单元格中。

您可以将字符串连接与 & 运算符一起使用：

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

将“C:”替换为包含当前驱动器号的任何变量。

Answer 2

要解决驱动器问题（没有前导空白）：

>> 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 放入单元格（一次）。