Dim ServerName() As String Dim DataName() As String Dim Server As String Dim I As Long Dim j As LongPublic Function SQLServerList(ByRef strServerName() As String, _ Optional ByRef rlngErrNum As Long, _ Optional ByRef rstrErrDescr As String) As Boolean
Dim objServerApp As SQLDMO.Application Dim objServers As SQLDMO.NameList Dim lngServerCount As Long On Error GoTo SQLServerListErr
SQLServerList = False Set objServerApp = New SQLDMO.Application Set objServers = objServerApp.ListAvailableSQLServers
Err.Clear SQLServerListErr: Set objServers = Nothing Set objServerApp = Nothing
rlngErrNum = Err.Number rstrErrDescr = Err.Description End FunctionPublic Function SQLDatabaseList(ByVal vstrServer As String, _ strDatabase() As String, _ Optional ByVal vstrUser As String = "sa", _ Optional ByVal vstrPassWord As String = "", _ Optional rlngErrNum As Long, Optional rstrErrDescr As String) As Boolean
Dim objServer As SQLDMO.SQLServer Dim lngDatabaseCount As Long On Error GoTo SQLDatabaseListErr
SQLDatabaseList = False Set objServer = New SQLDMO.SQLServer
Dim DataName() As String
Dim Server As String
Dim I As Long
Dim j As LongPublic Function SQLServerList(ByRef strServerName() As String, _
Optional ByRef rlngErrNum As Long, _
Optional ByRef rstrErrDescr As String) As Boolean
Dim objServerApp As SQLDMO.Application
Dim objServers As SQLDMO.NameList
Dim lngServerCount As Long
On Error GoTo SQLServerListErr
SQLServerList = False
Set objServerApp = New SQLDMO.Application
Set objServers = objServerApp.ListAvailableSQLServers
lngServerCount = objServers.Count
ReDim strServerName(lngServerCount - 1)
For I = 1 To lngServerCount
strServerName(I - 1) = objServers.Item(I)
Next I
SQLServerList = True
Err.Clear
SQLServerListErr:
Set objServers = Nothing
Set objServerApp = Nothing
rlngErrNum = Err.Number
rstrErrDescr = Err.Description
End FunctionPublic Function SQLDatabaseList(ByVal vstrServer As String, _
strDatabase() As String, _
Optional ByVal vstrUser As String = "sa", _
Optional ByVal vstrPassWord As String = "", _
Optional rlngErrNum As Long, Optional rstrErrDescr As String) As Boolean
Dim objServer As SQLDMO.SQLServer
Dim lngDatabaseCount As Long
On Error GoTo SQLDatabaseListErr
SQLDatabaseList = False
Set objServer = New SQLDMO.SQLServer
objServer.Connect "lch", vstrUser, vstrPassWord lngDatabaseCount = objServer.Databases.Count
ReDim strDatabase(lngDatabaseCount - 1)
For I = 1 To lngDatabaseCount
strDatabase(I - 1) = objServer.Databases.Item(I, "dbo").Name
Next I
SQLDatabaseList = True
Err.Clear
SQLDatabaseListErr:
Set objServer = Nothing
rlngErrNum = Err.Number
rstrErrDescr = Err.DescriptionEnd Function
Private Sub Command1_Click()
Call SQLServerList(ServerName())
For I = 0 To UBound(ServerName)
Text1 = Text1 & ServerName(I) & vbCrLfCall SQLDatabaseList(ServerName(I), DataName())
For j = 0 To UBound(DataName)
Text2 = Text2 & DataName(j) & vbCrLf
Next
NextEnd Sub找服务器和数据库