Run Time Error?

[Justin M]

Hey guys I have a prob, one of the users of a prog I made gets this error and I have no idea what it means or how to address it

Run-time error '-2147217396 (8004100c)':

Automation error

does anyone know how I can fix that?

[Doogle]

What does the program do? Is the user who's experiencing problems running under Vista? Has it ever worked for that user?

[Justin M]

Nope, it never worked for them.

They are using Win Xp PRO Sp2.

Its a program that when loads, searches for hardware on people machines and then gives info about the hardware device.

[Doogle]

You do distribute it as a Package and not just the .exe don't you ?

[Justin M]

Umm, well I use inno setup and I add vb run time files with it

It has the files the prog needs to run, the access database, the textfile

[westconn1]

at what point does the error occur, are you using WMI?
it appears this is a common error type when using WMI in vista

[Doogle]

I've come upon problems with distributing an application using Access if the target machine has an 'old' version of MDAC I think 2.8 and above is what's required. Perhaps you could post the code

[Justin M]

Sure here it is..

Private Sub Form_Load()
'mnuUpdates.Enabled = False
 
 
Dim objSoftware As WbemScripting.SWbemServices
Dim objOpsystem As WbemScripting.SWbemObjectSet
Dim objThisSys As WbemScripting.SWbemObject
Dim styOpSys As String
Dim strComputer As String
strComputer = "."
Set objSoftware = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
Set objOpsystem = objSoftware.ExecQuery _
    ("Select * from Win32_OperatingSystem")
 
For Each objThisSys In objOpsystem
    '
    ' Opsystem name and location
    ' eg Microsoft Windows XP Home Edition|C:\WINDOWS|\Device\Harddisk0\Partition1
    '
    Debug.Print objThisSys.Name
    '
    ' Service Pack version
    ' eg Service Pack 2
    '
    Debug.Print objThisSys.csdversion
    '
    ' Base version
    ' eg 5.1.2600
    '
    Debug.Print objThisSys.Version
Next
 
 
For Each objThisSys In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_OperatingSystem")
With objThisSys
Select Case Int(Val(.Version))
Case 6
Text3 = "Windows Vista"
Case 5
Text3 = "Windows XP"
Case 4
Text3 = "Windows 2000"
'etc.
Case 5
Text3 = "Windows ME"
Case 6
Text3 = "Windows 95"
 
 
Case 7
Text3 = "Windows 98"
End Select
End With
Next
 
'Dim objThisSys As Object
For Each objThisSys In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_OperatingSystem")
With objThisSys
Text2.Text = Text2 & .Name & ", " & .csdversion & ", " & .Version & vbCrLf
End With
Next
 
'Label23.Caption = strMsg
Label3.Visible = False
QuickSystemInfoFrame.Visible = False
fraProperties.Visible = True
Frame1.Visible = True
 
     Text14.Text = ("Computer name: " & Environ("computername"))
Text10.Text = ("Type of Operating System: " & Text2)
'Text10.Text = ("Type of Operating System: " & Environ("OS"))
'Label23.Caption = Environ("OS")
Text5.Text = ("Number of Processors: " & Environ("NUMBER_OF_PROCESSORS"))
Text13.Text = ("Processor Architecture: " & Environ("PROCESSOR_ARCHITECTURE"))
Label26.Caption = Environ("PROCESSOR_ARCHITECTURE")
Text12.Text = ("Processor Indentifier: " & Environ("PROCESSOR_IDENTIFIER"))
Text15.Text = ("Processor Level: " & Environ("PROCESSOR_LEVEL"))
Text7.Text = ("Processor Revision: " & Environ("PROCESSOR_REVISION"))
Text8.Text = ("Current UserName: " & Environ("USERNAME"))
Text9.Text = ("Location of User Profile: " & Environ("USERPROFILE"))
Text6.Text = (Environ("SystemDrive"))
Text11.Text = ("System Root: " & Environ("SystemRoot"))
' Initialize the ListView
    lsvProperties.ColumnHeaders.Add , , "Property"
    lsvProperties.ColumnHeaders.Add , , "Value"
    lsvProperties.View = lvwReport
    lsvProperties.ColumnHeaders(1).Width = lsvProperties.Width / 2 - 40
    lsvProperties.ColumnHeaders(2).Width = lsvProperties.Width / 2 - 40
    ' Get the hardware list
    cmdRefresh_Click
 
''begin battery status code''
lstInfo.AddItem "BatteryFullTime = " & Format$(Val(SysInfo.BatteryFullTime) * (1 / 3600), "##.0") & " Hours"
lstInfo.AddItem "BatteryLifeTime = " & Format$(Val(SysInfo.BatteryLifeTime) * (1 / 3600), "##.0")
lstInfo.AddItem "BatteryLifePercent = " & Format$(SysInfo.BatteryLifePercent / 100, "Percent")
        
Select Case SysInfo.BatteryStatus
Case 1
        lstInfo.AddItem "BatteryStatus = HIGH"
Case 2
        lstInfo.AddItem "BatteryStatus = LOW"
Case 4
        lstInfo.AddItem "BatteryStatus = CRITICAL"
Case 128
        lstInfo.AddItem "BatteryStatus = NO BATTERY"
Case 255
        lstInfo.AddItem "BatteryStatus = UNKNOWN"
End Select
'''end battery status code'''
 
   Dim wbemServices As Object
          Dim wbemObject As Object
          Dim wbemObjectSet As Object
          Dim wbemCounter As Integer
          Dim stemp As Long
          Set wbemServices = GetObject("winmgmts:" & "\\localhost\root\wmi")
          Set wbemObjectSet = wbemServices.InstancesOf("MSAcpi_ThermalZoneTemperature")
        For Each wbemObject In wbemObjectSet
  
             stemp = (wbemObject.CurrentTemperature - 2732) / 10
 
          Next
 
Label14 = stemp
If Label26.Caption = "x86" Then
Label28.Caption = "32-bit"
 
End If
 Dim iFileNo As Integer
  Dim sFileText As String
  
 
End Sub
 
 
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
ShellExecute Me.hwnd, "open", "http://www.geocities.com/nitrogenocide2003/MHXBuy2.html", vbNullString, vbNullString, ByVal 1&
Unload fComputerInfo
       MP3Stop
       UnloadAllForms Me
End Sub
 
 
 
Private Sub Frame7_DragDrop(Source As Control, X As Single, y As Single)
 
End Sub
 
Private Sub Label21_Click()
  ShellExecute Me.hwnd, "open", "mailto:[email protected]", vbNullString, vbNullString, vbNormalFocus
End Sub
 
Private Sub Label29_Click()
ShellExecute Me.hwnd, "open", "http://www.geocities.com/nitrogenocide2003/MHXBuy2.html", vbNullString, vbNullString, ByVal 1&
End Sub
 
 
 
 
 
 
Private Sub Label6_Click()
MsgBox "MHX Driver Searcher End User Licence Agreement: Revised March 19/2008. You (the user) are hereby allowed to use the free version on as many computers as you want for any reason. But by installing this software you agree not to reverse enginneer any part of this prog. The author of this program does not take ANY reponsibility for ANY usage of this program. Note: it may be wise to uninstall older versions or free versions before installing newer or the professional edition. The professional version can be install as many times as you wish on up to 3 computers."
End Sub
 
Private Sub mnuAbout_Click()
About.Show
End Sub
 
Private Sub mnuBuy_Click()
ShellExecute Me.hwnd, "open", "http://www.geocities.com/nitrogenocide2003/MHXBuy2.html", vbNullString, vbNullString, ByVal 1&
End Sub
 
Private Sub mnuExit_Click()
 
 
MP3Stop
Call UnloadAllForms(Me)
 
Unload Me
 
End Sub
 
Private Sub mnuFREE_Click()
ShellExecute Me.hwnd, "open", "http://microhardxce.vze.com", vbNullString, vbNullString, ByVal 1&
End Sub
 
Private Sub mnuSupport_Click()
ShellExecute Me.hwnd, "open", "http://z15.invisionfree.com/MicroHARDxce_Forums/index.php?", vbNullString, vbNullString, ByVal 1&
End Sub
 
Private Sub RichTextBox1_Change()
 
End Sub
 
 
 
Private Sub TabStrip1_Click()
 
With TabStrip1
        Select Case .SelectedItem.Caption
       
        
            Case "Hardware Information"
       fraProperties.Visible = True
       Frame1.Visible = True
       QuickSystemInfoFrame.Visible = False
       trvComputer.Visible = True
      
       Frame3.Visible = True
    
       
      
        Case "System Information"
        fraProperties.Visible = False
       Frame1.Visible = False
       QuickSystemInfoFrame.Visible = True
   
          Frame3.Visible = False
          trvComputer.Visible = False
     
       
      
   
                
                
                Case "Live Help"
                chatclient.Show
              
        End Select
    End With
 
End Sub
 
Private Sub Timer1_Timer()
If IsPlaying = False And Command1.Enabled = False And Command2.Caption = "Pause" Then MP3Play hwnd, nFileName
End Sub
 
Private Sub trvComputer_Click()
Dim vFullPath As Variant
Dim vItems As Variant
Dim vTemp As Variant
 
    ' Put the path parts of selected item into a variant array
    vFullPath = Split(trvComputer.SelectedItem.FullPath, "\")
    ' Check whether the user choose a device name
    If UBound(vFullPath) = 2 Then
        ' Update the TextBox with the chosen device name
        txtDevice.Text = vFullPath(2)
        Label19.Caption = vFullPath(2)
        On Error Resume Next
        ' Clear the ListView
        lsvProperties.ListItems.Clear
        ' Populate the ListView with the device's properties
        For Each vTemp In GetProperties(vFullPath)
            On Error Resume Next
            vItems = Split(vTemp, "^")
            lsvProperties.ListItems.Add(, , CStr(vItems(0))).SubItems(1) = vItems(1)
        Next vTemp
        ' Resize the columns width (in the ListView)
        Call AutosizeColumns(lsvProperties)
    End If
End Sub
 
Private Function GetProperties(vPath As Variant) As Variant
' This function returns all the properties of a specific device
Dim DeviceSet As SWbemObjectSet
Dim Device As SWbemObject
Dim iCount As Integer
Dim vTemp As Variant
Dim stemp As String
 
    On Error Resume Next
    ' Set theSWbemObjectSet object
    Set DeviceSet = GetObject("winmgmts:").InstancesOf("Win32_" & vPath(1))
    For Each Device In DeviceSet
        ' Check if the current device in the chosen device
        If Device.Caption = vPath(2) Then
            ' Get all the properties of the chosen device
            For Each vTemp In Device.Properties_
                On Error Resume Next
                If vTemp <> "" And vTemp <> vbNull Then
                    ' Add the property name and its value to the temporary string
                    stemp = stemp & vTemp.Name & "^" & vTemp & "|"
                End If
            Next
            ' Remove the '|' character at the end of the string
            If Right(stemp, 1) = "|" Then
                stemp = Left(stemp, Len(stemp) - 1)
            End If
        End If
    Next Device
    ' Return an array containing the device properties
    GetProperties = Split(stemp, "|")
End Function
 
 
[B][/B]

[Justin M]

And

Option Explicit
 
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
   
        End Type
        Private blnQuit As Boolean
        Private Declare Function GetTickCount& Lib "kernel32" ()
 Private Const SND_APPLICATION = &H80         '  look for application specific association
 
      Private Const SND_ALIAS = &H10000     '  name is a WIN.INI [sounds] entry
 
      Private Const SND_ALIAS_ID = &H110000    '  name is a WIN.INI [sounds] entry identifier
 
      Private Const SND_ASYNC = &H1         '  play asynchronously
 
      Private Const SND_FILENAME = &H20000     '  name is a file name
 
      Private Const SND_LOOP = &H8         '  loop the sound until next sndPlaySound
 
      Private Const SND_MEMORY = &H4         '  lpszSoundName points to a memory file
 
      Private Const SND_NODEFAULT = &H2         '  silence not default, if sound not found
 
      Private Const SND_NOSTOP = &H10        '  don't stop any currently playing sound
 
      Private Const SND_NOWAIT = &H2000      '  don't wait if the driver is busy
 
      Private Const SND_PURGE = &H40               '  purge non-static events for task
 
      Private Const SND_RESOURCE = &H40004     '  name is a resource name or atom
 
      Private Const SND_SYNC = &H0         '  play synchronously (default)
 
   
      Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
   
      Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
   
      Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
   
      Const REG_SZ = 1
   
     Const HKEY_LOCAL_MACHINE = &H80000001
   
      Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Run"
   
      Const KEY_WRITE = &H20006
      ''' Code for chat user names.
     ' Option Explicit
 
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private mmOpen As String, sec As Integer, mins As Integer
Dim nFileName As String
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, ByVal wMsg As Long, _
                 ByVal wParam As Long, lParam As Any) As Long
                 
     
 
 
        Public Function IsPlaying() As Boolean
Static s As String * 30
mciSendString "status MP3Play mode", s, Len(s), 0
IsPlaying = (Mid$(s, 1, 7) = "playing")
End Function
 
 
            
  Public Function MP3Play(wndHandle As Long, sFileName As String)
  Dim cmdToDo As String * 255
  Dim dwReturn As Long
  Dim Ret As String * 128
  Dim tmp As String * 255
  Dim lenShort As Long
  Dim ShortPathAndFie As String, glo_HWND As Long
    If Dir(sFileName) = "" Then
         mmOpen = "Error with input file"
         Exit Function
    End If
  lenShort = GetShortPathName(sFileName, tmp, 255)
  ShortPathAndFie = Left$(tmp, lenShort)
  glo_HWND = wndHandle
  cmdToDo = "open " & ShortPathAndFie & " type MPEGVideo Alias MP3Play"
  dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)
  If dwReturn <> 0 Then  'not success
     mciGetErrorString dwReturn, Ret, 128
     mmOpen = Ret
     MsgBox Ret, vbCritical
     Exit Function
  End If
  mmOpen = "Success"
  mciSendString "play MP3Play", 0, 0, 0
End Function
 
Public Function MP3Pause()
  mciSendString "pause MP3Play", 0, 0, 0
End Function
 
Public Function MP3UnPause()
  mciSendString "play MP3Play", 0, 0, 0
End Function
 
Public Function MP3Stop() As String
  mciSendString "stop MP3Play", 0, 0, 0
  mciSendString "close MP3Play", 0, 0, 0
End Function
 
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function
  
Private Function GetDevice(DeviceName As String) As Variant
' In this function we will get the devices referring to the given class name
Dim DeviceSet As SWbemObjectSet
Dim Device As SWbemObject
Dim iCount As Integer
Dim stemp As String
 
    On Error Resume Next
    ' Set the SWbemObjectSet object
    Set DeviceSet = GetObject("winmgmts:").InstancesOf(DeviceName)
    
    ' Get the devices captions
    For Each Device In DeviceSet
        stemp = stemp & Device.Caption & "|"
    Next Device
    ' Remove the '|' character at the end of the string
    If Right(stemp, 1) = "|" Then stemp = Left(stemp, Len(stemp) - 1)
    ' Return an array (variant) with the devices captions
    GetDevice = Split(stemp, "|")
End Function
 
   
Private Sub UnloadAllForms(AForm As Form)
 
    'This code shuts down all forms and prevents multiple instances
    ' if any other programs are made, make sure they include this code.
    Dim frm As Form
    
    For Each frm In Forms
        If frm.Name <> AForm.Name Then
            Unload frm
            Set frm = Nothing
        End If
    Next
 
 
End Sub

[Justin M]

AND

Option Explicit
 
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
   
        End Type
        Private blnQuit As Boolean
        Private Declare Function GetTickCount& Lib "kernel32" ()
 Private Const SND_APPLICATION = &H80         '  look for application specific association
 
      Private Const SND_ALIAS = &H10000     '  name is a WIN.INI [sounds] entry
 
      Private Const SND_ALIAS_ID = &H110000    '  name is a WIN.INI [sounds] entry identifier
 
      Private Const SND_ASYNC = &H1         '  play asynchronously
 
      Private Const SND_FILENAME = &H20000     '  name is a file name
 
      Private Const SND_LOOP = &H8         '  loop the sound until next sndPlaySound
 
      Private Const SND_MEMORY = &H4         '  lpszSoundName points to a memory file
 
      Private Const SND_NODEFAULT = &H2         '  silence not default, if sound not found
 
      Private Const SND_NOSTOP = &H10        '  don't stop any currently playing sound
 
      Private Const SND_NOWAIT = &H2000      '  don't wait if the driver is busy
 
      Private Const SND_PURGE = &H40               '  purge non-static events for task
 
      Private Const SND_RESOURCE = &H40004     '  name is a resource name or atom
 
      Private Const SND_SYNC = &H0         '  play synchronously (default)
 
   
      Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
   
      Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
   
      Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
   
      Const REG_SZ = 1
   
     Const HKEY_LOCAL_MACHINE = &H80000001
   
      Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Run"
   
      Const KEY_WRITE = &H20006
      ''' Code for chat user names.
     ' Option Explicit
 
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private mmOpen As String, sec As Integer, mins As Integer
Dim nFileName As String
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, ByVal wMsg As Long, _
                 ByVal wParam As Long, lParam As Any) As Long
                 
     
 
 
        Public Function IsPlaying() As Boolean
Static s As String * 30
mciSendString "status MP3Play mode", s, Len(s), 0
IsPlaying = (Mid$(s, 1, 7) = "playing")
End Function
 
 
            
  Public Function MP3Play(wndHandle As Long, sFileName As String)
  Dim cmdToDo As String * 255
  Dim dwReturn As Long
  Dim Ret As String * 128
  Dim tmp As String * 255
  Dim lenShort As Long
  Dim ShortPathAndFie As String, glo_HWND As Long
    If Dir(sFileName) = "" Then
         mmOpen = "Error with input file"
         Exit Function
    End If
  lenShort = GetShortPathName(sFileName, tmp, 255)
  ShortPathAndFie = Left$(tmp, lenShort)
  glo_HWND = wndHandle
  cmdToDo = "open " & ShortPathAndFie & " type MPEGVideo Alias MP3Play"
  dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)
  If dwReturn <> 0 Then  'not success
     mciGetErrorString dwReturn, Ret, 128
     mmOpen = Ret
     MsgBox Ret, vbCritical
     Exit Function
  End If
  mmOpen = "Success"
  mciSendString "play MP3Play", 0, 0, 0
End Function
 
Public Function MP3Pause()
  mciSendString "pause MP3Play", 0, 0, 0
End Function
 
Public Function MP3UnPause()
  mciSendString "play MP3Play", 0, 0, 0
End Function
 
Public Function MP3Stop() As String
  mciSendString "stop MP3Play", 0, 0, 0
  mciSendString "close MP3Play", 0, 0, 0
End Function
 
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function
  
Private Function GetDevice(DeviceName As String) As Variant
' In this function we will get the devices referring to the given class name
Dim DeviceSet As SWbemObjectSet
Dim Device As SWbemObject
Dim iCount As Integer
Dim stemp As String
 
    On Error Resume Next
    ' Set the SWbemObjectSet object
    Set DeviceSet = GetObject("winmgmts:").InstancesOf(DeviceName)
    
    ' Get the devices captions
    For Each Device In DeviceSet
        stemp = stemp & Device.Caption & "|"
    Next Device
    ' Remove the '|' character at the end of the string
    If Right(stemp, 1) = "|" Then stemp = Left(stemp, Len(stemp) - 1)
    ' Return an array (variant) with the devices captions
    GetDevice = Split(stemp, "|")
End Function
 
   
Private Sub UnloadAllForms(AForm As Form)
 
    'This code shuts down all forms and prevents multiple instances
    ' if any other programs are made, make sure they include this code.
    Dim frm As Form
    
    For Each frm In Forms
        If frm.Name <> AForm.Name Then
            Unload frm
            Set frm = Nothing
        End If
    Next
 
 
End Sub

[westconn1]

as you havenot specified where the error is happening, hard to make any further comment, but it would appear it is a WMI issue

[Justin M]

I don't know where the error could happen as it works fine on my computer.

What is this WMI?

[westconn1]

What is this WMI?

windows management

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

you will need to use error handling to create a logfile or similar method of debugging your application, so that you know exactly which line of code is creating the error

if you want anyone here to test your code, zip your project and attach it to a post, too hard to want to create a project with all the controls and references that may be required to make it run, from the code posted above

[randem]

Let's see that script to make sure you haven't forgotten something...

[westconn1]

Let's see that script to make sure you haven't forgotten something...

i believe all the code for that is in post #8

[randem]

i believe all the code for that is in post #8

Hmmmm.... That looks like VB code not a Inno Setup Script but I could be wrong... What do I know...