VB6 Automation error

[hoong]

The runtime error -2147217396 (8004100c) keep occurs once i attempt to run this code to get the received signal strength of my WLAN card from WMI by using VB6 in Windows Vista. So is there any solution to solve this automation error ? Is VB6 cant access to certain WMI function in Windows Vista?

Private Sub Command1_Click()
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\WMI")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM MSNdis_80211_ReceivedSignalStrength", , 48)
For Each objItem In colItems
Text1 = objItem.Ndis80211ReceivedSignalStrength

Next

End Sub

Thanks in advance

[AndreRet]

Have a look at this LINK.

Use this to trap the exact error - Error Trapping WMI.

And lastly THIS should contain your solution:)

[hoong]

Hi AndreRet, thanks for the sharing the link....

I have go through all , and still got the same runtime error occurs .....

Is there any other solution besides that for this automation error between WMI and VB6 ?

[hoong]

When i debug it, it keeps point to the line For Each objItem In colItems dan highlight it ... :(

[AndreRet]

It can not find the item referenced, hence your problem. I'll play with this code and see what your solution might be.:)

[hoong]

ok,will it related to VB and WMI compatible problem in Vista? thanks many for your effort on this matter.....hope to get good news from you soon :)

[AndreRet]

I saw the other posts on your question at THIS link. Still seems that there is an error although your wlan card is registered in WMI, mmmm.

Have a look at the following code I found HERE, which seems that they had a similar problem. It was as I expected all to do with your declarations and the calling of the functions. Try the code below...

Dim WMI
    Dim wmiWin32Objects
    Dim wmiWin32Object
    Dim i As Integer
    i = 1
    ' ***** NIC Configuration Info *****
    Set WMI = GetObject("WinMgmts://" & strComputerName)
    Set wmiWin32Objects = WMI.InstancesOf("Win32_NetworkAdapterConfiguration")
    
    With wmiWin32Object
        For Each wmiWin32Object In wmiWin32Objects
            
            'Typically index one is your actual NIC card. AFAIK
            'Remmed out index so you can see them all, but its only
            'the NIC card that fails, since it actually has info
            'for IP, Gateway, and DNS.
            
            'If .Index = 1 Then
                Debug.Print "Adapter : " & i
                Debug.Print .Description
                Debug.Print .MACAddress
                Debug.Print .ipaddress(0)
                Debug.Print .DefaultIPGateway(0)
                Debug.Print .DNSServerSearchOrder(0)
                
            'End If
            i = i + 1
        Next wmiWin32Object
    End With
    
End Sub

This is handling a ton of other WMI functions...

'Lets play with some WMI stuff, very useful info.
    Dim WMI
    Dim wmiWin32Objects
    Dim wmiWin32Object
    Dim sComputerName As String     'Stores the Computer name.
    Dim sWinUserName As String      'Stores the User name currently logged in.
    Dim blnNew As Boolean           'True if its a new entry, otherwise false and we need to update.
    Dim x As Integer
    
    'List of Variables retrieved from the WMI object. ADD more in list where apropriate
    'Try and keep variables in order.
    Dim sProcName As String         'Name of the processor.
    Dim sManufacturer As String     'Processor Manufacturer.
    Dim nCurClockSpeed As Integer   'Stores the Current Clock speed of the processor.
    Dim nMaxClockSpeed As Integer   'Max clock speed of the processor.
    
    Dim sNICMan As String           'NIC card Manufacturer.
    Dim sNICprod As String          'NIC card product name.
    
    Dim sIPAddress As String        'Computers IP address.
    Dim sDefaultGateway As String   'Default gateway settings.
    Dim sDNS As String              'System's DNS server search settings.
    Dim sMACAddress As String       'MAC address.
    
    Dim nMemoryMB                   'Memory in MB's.
    
    Dim sHardDriveModel As String   'Hard drive model yup that simple.
    Dim nHardDriveSizeGig As Long   'Hard drive size in gig's.
    Dim nAvailableSpaceMB As Long   'Free space on hard drive in megs.
    Dim nHDIndex As Integer         'The index of the drive, to weed out drive types we don't want.
    
    Dim sFileSystem As String       'File System IE: NTFS.
    
    'Creates a variable containing information such as computer name and username
    Dim loSysInfo As New ActiveDs.WinNTSystemInfo
    
    'First we will gather all the information we can about the computer
    'Populate the variables with this information depending on the OS
    If getVersion() = "Windows XP" Then
        
        'Do all this getting certain info shizat for XP users.
        
        sWinUserName = loSysInfo.UserName
        sComputerName = loSysInfo.ComputerName
        
        Set WMI = GetObject("WinMgmts://" & sComputerName)
        
        ' ***** Processor info *****
        Set wmiWin32Objects = WMI.InstancesOf("Win32_Processor")
        With wmiWin32Object
            For Each wmiWin32Object In wmiWin32Objects
                
                sProcName = .Name 'Processor Name EX: AMD Athlon(tm) processor
                sManufacturer = .Manufacturer
                nCurClockSpeed = .CurrentClockSpeed
                nMaxClockSpeed = .MaxClockSpeed
                
            Next
        End With
        
        ' ***** Network Adapter Stuff *****
        Set WMI = GetObject("WinMgmts://" & strComputerName)
        Set wmiWin32Objects = WMI.InstancesOf("Win32_NetworkAdapter")
        
        With wmiWin32Object
            For Each wmiWin32Object In wmiWin32Objects

                'Typically index one is your actual NIC card. AFAIK
                If .Index = 1 Then
                    sNICMan = .Manufacturer
                    sNICprod = .ProductName
                    
                End If
                
            Next wmiWin32Object
        End With
        
        ' ***** NIC Configuration Info *****
        Set WMI = GetObject("WinMgmts://" & strComputerName)
        Set wmiWin32Objects = WMI.InstancesOf("Win32_NetworkAdapterConfiguration")
        
        With wmiWin32Object
            For Each wmiWin32Object In wmiWin32Objects
                
                'Typically index one is your actual NIC card. AFAIK
                If .Index = 1 Then
                    sIPAddress = .IPAddress(0)
                    sDefaultGateway = .DefaultIPGateway(0)
                    x = 0
                    sDNS = ""
                    For x = 0 To UBound(.DNSServerSearchOrder)
                        If sDNS = "" Then
                            sDNS = .DNSServerSearchOrder(x)
                        Else
                            sDNS = sDNS & STRING_TERM & .DNSServerSearchOrder(x)
                        End If
                        
                    Next
                    sMACAddress = .MACAddress
                End If
                
            Next wmiWin32Object
        End With
        
        ' ***** Computer System Info *****
        Set WMI = GetObject("WinMgmts://" & strComputerName)
        Set wmiWin32Objects = WMI.InstancesOf("Win32_ComputerSystem")
        
        With wmiWin32Object
            For Each wmiWin32Object In wmiWin32Objects
                
                'Divisions adjust to MB and adding one rounds up after dropping decimals.
                nMemoryMB = Round(.TotalPhysicalMemory / 1024 / 1024)
                
            Next wmiWin32Object
        End With
        
        ' ***** Hard Drive Info *****
        Set WMI = GetObject("WinMgmts://" & strComputerName)
        Set wmiWin32Objects = WMI.InstancesOf("Win32_DiskDrive")
        
        'Initialize the index of hard drives to 0.
        nHDIndex = 0
        
        With wmiWin32Object
            For Each wmiWin32Object In wmiWin32Objects
                
                'Mostly used cause the boss man has an Iomega zip and it buggers this up.
                'VB doesn't like nulls and for removeable drives .size is a null value.
                If (.Index = nHDIndex And InStr(.Model, "IOMEGA") = 0) And Not (IsNull(.Size)) Then
                    sHardDriveModel = .Model
                    nHardDriveSizeGig = Round(.Size / 1024 / 1024 / 1024) 'division is to adjust to gig.
                Else
                    nHDIndex = nHDIndex + 1
                End If
                
            Next wmiWin32Object
        End With
        
        'Variables and such to retrieve some more information about the hard drive that WMI doesn't.
        Dim fso As FileSystemObject
        Dim Blah As Drive
        Set fso = New FileSystemObject
        Set Blah = fso.GetDrive("C:")
        
        'Hard drive free space. IE available disk space left on drive.
        nAvailableSpaceMB = Blah.AvailableSpace / 1024 / 1024
        sFileSystem = Blah.FileSystem
        
    Else
        'Do all this getting certain info for 98 Losers.
        'Can you say we don't do jack sheet WOOTZOR! by the word of god (Dave)
        Exit Function
    End If
    
    'Default value is a new entry.
    blnNew = True
    
    'Determine if the Computer is already in the database.
    'If the computer is already in the DB then update otherwise insert.
    EmployeeLogin.dbo_SelecttblPCInfo
    Do Until EmployeeLogin.rsdbo_SelecttblPCInfo.EOF = True
        If EmployeeLogin.rsdbo_SelecttblPCInfo("ComputerName") = sComputerName Then
            blnNew = False
            Exit Do
        End If
        blnNew = True
        EmployeeLogin.rsdbo_SelecttblPCInfo.MoveNext
    Loop
    Call rsOpen(EmployeeLogin.rsdbo_SelecttblPCInfo, False)
    
    If blnNew = False Then
        'Enter as update
        EmployeeLogin.dbo_UpdatetblPCInfo sComputerName, sWinUserName, Now, sProcName, sManufacturer, _
                        nCurClockSpeed, nMaxClockSpeed, sNICMan, sNICprod, sIPAddress, sDefaultGateway, _
                        sDNS, sMACAddress, nMemoryMB, sHardDriveModel, nHardDriveSizeGig, nAvailableSpaceMB, _
                        sFileSystem
    Else
        'Enter as new computer
        EmployeeLogin.dbo_InsertNewPCInfo sComputerName, sWinUserName, Now, sProcName, sManufacturer, _
                        nCurClockSpeed, nMaxClockSpeed, sNICMan, sNICprod, sIPAddress, sDefaultGateway, _
                        sDNS, sMACAddress, nMemoryMB, sHardDriveModel, nHardDriveSizeGig, nAvailableSpaceMB, _
                        sFileSystem
    End If

[hoong]

ya AndreRet, i try your code and still get the same runtime error, and quite blur with the error occurs.....so do you have any suggestion for the possible solution to my problem in extracting WMI wireless LAN card data using VB6 script?

[AndreRet]

Try the following, not in vbscript, but some code I found from an old app. -

Public Function GetSignalStrength() As String
On Error GoTo oops

Dim query As ManagementObjectSearcher
Dim Qc As ManagementObjectCollection
Dim Oq As ObjectQuery
Dim Ms As ManagementScope
Dim Co As ConnectionOptions
Dim Mo As ManagementObject
Dim outp As String

Co = New ConnectionOptions
Ms = New ManagementScope("root\wmi")
Oq = New ObjectQuery("SELECT * FROM MSNdis_80211_ReceivedSignalStrength Where active=true")
query = New ManagementObjectSearcher(Ms, Oq)
Qc = query.Get
outp = ""

For Each Mo In query.Get
outp = outp & Mo("Ndis80211ReceivedSignalStrength") & " "
ISIPActive = Mo("Active")
Next

Return Trim(outp)
Exit Function
oops:
Return Err.Description
End Function

[hoong]

May i know what is this code ? not in VB script means cant run in VB6? i try to use this code in a command button in VB6, and return with compile error, Expected End Sub

[hoong]

and i also get this error when attempt to run your code using Onscript Editor : Microsoft VBScript compilation error: Expected statement: Public Function GetSignalStrength() As String

[AndreRet]

This will work fine in vb6. I've tested the code and it returns a perfect value.

On which line did the error occur?

Change the Private Function to a Public Function in a module and not on a form level.

[hoong]

You just paste and run the code in the VB6 command declaration ?

[AndreRet]

I now seem to get errors on the code supplied. Let me play with this and find a final solution.:)

[AndreRet]

Here is a vbScript I found. Might work. It came from HERE with help on how to declare all and initiate into your app.:)

'Wireless Signal Strength

'Sigstrength and SSID: Copyright 2004, David Wheeler
drwhee***@lycos.com

'SigStrengthBar and SigStrengthPercent added by Hans Heigenhauser
h***@heigenhauser.net 20.06.2004

'Not redistributable without express permission from authors.

'SigStrength determines the Signalstrength of a WLAN-Connection via
WMI. It returns a negative number which decreases with loss of
'Signalstrength. i.e. -50 is better than -80. The correspinding
WMI-function is not included in the WMI-Meters of Samurize.

'SSID determines the Service Identifier Set (or "WLAN-Name") of the
WLAN you are connected to via WMI.The correspinding WMI-function
'is not included in the WMI-Meters of Samurize.

'SigStrengthBar simulates the original display of the Windows XP
Wireless Network Status Display with only 5 possible signal
'strengths. The values that determine the display were gathered by
simple trial and may vary a little bit from the display windows
'provides, although I don't think they do.

'SigStrengthPercent returns a percentage of the maximal reachable
signalstrength. The Constant "maxstrength" was gathered by
'trial in a distance of 20cm from my receiver and can be changed by
changing the value of the constant after this lines.
'The value for your system can be determined with the function
"SigStrength". Just change the place of your System until
'you have found the maximum value of SigStrenth (this would be the
lowest negative number, as described in the description of
'SigStrength)

const maxstrength = -30

on error resume Next

Private Sub GetWMI(WMIArray, WMIQuery)
   Set WMIClass =
GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\wmi")
   Set WMIArray = WMIClass.ExecQuery(WMIQuery)
End Sub

Function SigStrength()
   Call GetWMI(objMSNdis_80211_ReceivedSignalStrengthSet, "Select *
from MSNdis_80211_ReceivedSignalStrength Where active=true")
   For Each objMSNdis_80211_ReceivedSignalStrength in
objMSNdis_80211_ReceivedSignalStrengthSet
       SigStrength =
objMSNdis_80211_ReceivedSignalStrength.Ndis80211ReceivedSignalStrength
   Next
End Function

Function SigStrengthBar()
   Call GetWMI(objMSNdis_80211_ReceivedSignalStrengthSet, "Select *
from MSNdis_80211_ReceivedSignalStrength Where active=true")

   For Each objMSNdis_80211_ReceivedSignalStrength in
objMSNdis_80211_ReceivedSignalStrengthSet
       SigStrengthBarRaw =
objMSNdis_80211_ReceivedSignalStrength.Ndis80211ReceivedSignalStrength
   Next
   SigStrengthBar=0
   If SigStrengthBarRaw > -57 Then
    SigStrengthBar=5
   ElseIf SigStrengthBarRaw > -68 Then
    SigStrengthBar=4
   ElseIf SigStrengthBarRaw > -72 Then
    SigStrengthBar=3
   ElseIf SigStrengthBarRaw > -80 Then
    SigStrengthBar=2
   ElseIf SigStrengthBarRaw > -90 Then
    SigStrengthBar=1
   End If

End Function

Function SigStrengthPercent()
   Call GetWMI(objMSNdis_80211_ReceivedSignalStrengthSet, "Select *
from MSNdis_80211_ReceivedSignalStrength Where active=true")

   For Each objMSNdis_80211_ReceivedSignalStrength in
objMSNdis_80211_ReceivedSignalStrengthSet
       SigStrengthPercentRaw =
objMSNdis_80211_ReceivedSignalStrength.Ndis80211ReceivedSignalStrength
   Next

SigStrengthPercent=(SigStrengthPercentRaw+100)*(100/(maxstrength+100))

End Function

Function SSID()
   Call GetWMI(objMSNdis_80211_ServiceSetIdentifierSet, "Select * from
MSNdis_80211_ServiceSetIdentifier Where active=true")

   For Each objMSNdis_80211_ServiceSetIdentifier in
objMSNdis_80211_ServiceSetIdentifierSet
       ID = ""
       For i = 0 to
objMSNdis_80211_ServiceSetIdentifier.Ndis80211SsId(0)
         ID = ID &
chr(objMSNdis_80211_ServiceSetIdentifier.Ndis80211SsId(i + 4))
       Next
       SSID = ID
   Next
End Function

[hoong]

I have try the first part

Private Sub GetWMI(WMIArray, WMIQuery)
Set WMIClass =
GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\wmi")
Set WMIArray = WMIClass.ExecQuery(WMIQuery)
End Sub

Function SigStrength()
Call GetWMI(objMSNdis_80211_ReceivedSignalStrengthSet, "Select *
from MSNdis_80211_ReceivedSignalStrength Where active=true")
For Each objMSNdis_80211_ReceivedSignalStrength in
objMSNdis_80211_ReceivedSignalStrengthSet
SigStrength =
objMSNdis_80211_ReceivedSignalStrength.Ndis80211ReceivedSignalStrength
Next
End Function

but it cant run also , then i check that class in wbemtest (root\wmi) and found that there is an error for Ndis Received Signal Strength.... so i guess maybe is WMI problem to avoid vb6 from extract the data from it

[AndreRet]

Hoong, have a look at this link - HERE. It covers some other possible solutions that does not form part of the code. The above code worked fine on my system in XP, Vista and Win 7.

Are you currently running a 32 or 64 bit. There is different registries for both, it might be that it tries to read from 32 (which contains nothing) whilst you are using 64 (which contains the wmi)

[AndreRet]

Also, try this link by Randy Birch. He is very well versed on API and registry use. Just search for a solution over There.

[hoong]

I am using Vista 32 bit OS

[AndreRet]

I am dumbstruck then. It now becomes personal, I WANT to solve this....:)

[hoong]

I get User defined type not defined for Dim WMIClass as SWbemObjectSet.....can you just show me your code which can works to get Ndis80211ReceivedSignalStrength ? i have try many times but still get automation error, out of idea already

[hoong]

will it is the WMI problem in Vista? i can access root\cimv2 parameter, but cant access to root\wmi for the MSNdis Received Signal Strength

[AndreRet]

My vista laptop is at home. I will have to test from there. Will let you know.

In the interim, have a look at THIS.

[hoong]

ok, wait for your good news :)