VBA WMI Intermittent Error

D

david.richards

Hi,

I have created a simple VBA program to retrieve the current disk space
on our server into an Excel workbook. One of the servers that I'm
running the query against is located on another trusted domain. When I
run the VBA code on my workstation, logged on as me the code run fine,
but if I run the same code on one of our servers (still logged on as
me) the code fails with the error 80070721, "a security package
specific error occurred". As you can see from the code below, I'm
using Impersonation level impersonate. If I change this and specify a
user name and password (the one I'm currently logged on as ) it all
works fine. I'm running Windows XP SP2 on my workstation and Windows
2003 Server SP 1 on the other server. The server in the other domain
is running Windows 2000 Server SP3 (Upgraded from Windows NT 4).
Any help would be much appreciated.

Sub GetDiskInformation(strComputer As String)
Dim objDisk As Object
Dim colDisks As Object
Dim objWMIService As Object
Dim intCount As Integer
Dim intColumnID As Integer
Dim dblFreeSpace As Double
Dim dblTotalSize As Double
Dim strGB As String

'On Error GoTo errormessage

intColumnID = 1

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root
\cimv2")

Set colDisks = objWMIService.ExecQuery("Select * from
Win32_LogicalDisk")

Sheets("Disk Space").Cells(intRowID + 1, intColumnID).Value =
strComputer

For Each objDisk In colDisks
If objDisk.drivetype = 3 Then
dblFreeSpace = objDisk.FreeSpace / 1024 / 1024 / 1024
dblTotalSize = objDisk.Size / 1024 / 1024 / 1024

If dblFreeSpace < 1 Then
dblFreeSpace = dblFreeSpace * 1000
blnGB = " MB"
Else
blnGB = " GB"
End If

If dblTotalSize < 1 Then
dblTotalSize = dblTotalSize * 1000
blngb2 = " MB"
Else
blngb2 = " GB"
End If

dblFreeSpace = Round(dblFreeSpace, 2)
dblTotalSize = Round(dblTotalSize, 2)

Sheets("Disk Space").Cells(intRowID + 1, intColumnID +
1).Value = objDisk.DeviceID
Sheets("Disk Space").Cells(intRowID + 1, intColumnID +
2).Value = dblFreeSpace & blnGB & "(" & dblTotalSize & blngb2 & ")"
intColumnID = intColumnID + 2
End If
Next

intRowID = intRowID + 1

errormessage:
Set objWMIService = Nothing
End Sub

Thanks in advance
Dave
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top