MartyConnelly
martyconnelly at shaw.ca
Fri Jan 27 12:44:23 CST 2006
If you mean SQL Servers see below; if you mean all types of servers
that's a bit trickier
Sub listsql()
' For a single workstation list sql servers with no network available
'otherwise you need to get all computer names from WMI and iterate
Dim strServer As String
Dim objWMIService As Object
Dim colInstances As Object
Dim objServices As Object
Dim objInstance As Object
Dim objLocator As Object
Dim i As Long
strComputer = "." 'local default computer name
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
Set objServices = objLocator.ConnectServer(strServer,
"root\MicrosoftSQLServer")
objServices.Security_.ImpersonationLevel = 3
Set colInstances = objServices.InstancesOf("MSSQL_SQLServer")
i = 0
For Each objInstance In colInstances
i = i + 1
MsgBox objInstance.Truename & " as instance Truename from WMI"
Next
End Sub
or
'
' Over a network domain
'
' http://www.codeguru.com/vb/gen/vb_system/network/article.php/c1641
'
Private Declare Function lstrlenW Lib "kernel32" (ByVal _
lpString As Long) As Long
'
Private Declare Function NetServerEnum Lib "netapi32" ( _
strServername As Any, _
ByVal level As Long, _
bufptr As Long, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal servertype As Long, _
strDomain As Any, _
resumehandle As Long) As Long
'
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" _
(ByVal lpBuffer As Long) As Long
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
'
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
'
Private Type SV_100
platform As Long
name As Long
End Type
'
'
Public Sub GetSQLServers()
'
' You could change this to be a function returning
' a list of the SQL servers in a ADOR Recordset or an array etc.
'
' At present, it just does a debug.print of all the
' SQL servers on the network.
'
' http://www.codeguru.com/vb/gen/vb_system/network/article.php/c1641
Dim l As Long
Dim entriesread As Long
Dim totalentries As Long
Dim hREsume As Long
Dim bufptr As Long
Dim level As Long
Dim prefmaxlen As Long
Dim lType As Long
Dim domain() As Byte
Dim i As Long
Dim sv100 As SV_100
'
level = 100
prefmaxlen = -1
'
lType = SV_TYPE_SQLSERVER
'domain = "placeYourDomainNameHere" & vbNullChar
domain = "Marty" & vbNullChar
l = NetServerEnum(ByVal 0&, _
level, _
bufptr, _
prefmaxlen, _
entriesread, _
totalentries, _
lType, _
domain(0), _
hREsume)
If l = 0 Or l = 234& Then
For i = 0 To entriesread - 1
CopyMemory sv100, ByVal bufptr, Len(sv100)
Debug.Print Pointer2stringw(sv100.name)
bufptr = bufptr + Len(sv100)
Next i
End If
NetApiBufferFree bufptr
'
End Sub
Paul Hartland (ISHARP) wrote:
>To all,
>
>Not sure if this is possible, but is there a way via code that I can return
>the names of all current active servers. Basically when I open an access DB
>I want it to run through I list of our server names then tell me if a
>connection can be established.
>
>Thanks in advance for any help/code/pointers on this
>
>Paul Hartland
>Database Developer
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada