I'm developing a macro to query SQL databases. Currently
I require the users to type in the name of their SQL
database for the code to work. Typing errors in the name
cause the code to fail. Is there any code I can use to
bring up the Data/Get External Data/New Database Query
Dialog box? Or better yet, a list of just the SQL
databases available through ODBC.
My current code is as follows.
Sub DemoQuickTrans()
Dim strConnectionString As String
Dim strSQLDatabaseName, strSQLName, strSQLDatabase,
strLoginID, strPassword As String
Dim strSqlString, strVersion, strSUNDatabase,
strPeriodFrom, strPeriodTo As String
Dim intFindDot As Integer
'Poplulate Login Strings
strLoginID = Range("Login_ID").Value
strPassword = Range("Password").Value
strSQLDatabaseName = Range("SQL_Database_Name").Value
'strSQLDatabaseName = YOUR-HPBMYE9TMB.SUNDB
'was hoping for
'strSQLDatabaseName = dialog .... .show or a list of SQL
databases
intFindDot = Application.WorksheetFunction.Find(".",
strSQLDatabaseName, 1)
strSQLName = Left(strSQLDatabaseName, intFindDot - 1)
strSQLDatabase = Mid(strSQLDatabaseName, intFindDot + 1,
100)
'I saw somewhere on the Google search that the WSID is
not necessary, can anyone tell me what it is and if not
why not?
strConnectionString = _
"ODBC;DSN=" & strSQLDatabaseName & ";UID=" & strLoginID
& ";PWD=" & strPassword & ";SQL " & _
";WSID=" & strSQLName & ";DATABASE=" & strSQLDatabase
& ";AutoTranslate=No,"
'and so on
End Sub
Thanks in advance
Matt
To experiment, create a new and empty text file and rename its extension to UDL. Double click on it from within Windows Explorer.
No I haven't considered udl files as I don't know
anything about them. Am reasonably familiar with using VB
to drive SQL and just need this last bit of code to make
my solution foolproof.
Did as you suggested but got an error message "File
cannot be opened. Ensure it is a valid Data Link file."
Can anyone else help?
Thanks
Matt
>.
>
> Can anyone else help?
There are a couple of issues. First, you must enumerate available
servers:
Sub test()
Dim oSqlApp As Object
Dim vntName As Variant
Set oSqlApp = CreateObject("SQLDMO.Application")
With oSqlApp
For Each vntName In .ListAvailableSQLServers
Debug.Print vntName
Next
End With
End Sub
To enumerate each database on a server, you first have to connect to
the server i.e. you need to pass security for that server.
Assuming you can connect:
Dim oServer As Object
Dim oDatabase As Object
Set oServer = CreateObject("SQLDMO.SQLServer")
With oServer
.Connect "MYSERVER", "MYUID", "MYPASSWORD"
For Each oDatabase In .Databases
Debug.Print oDatabase.Name
Next
End With
--
Sorry it's taken so long to come back you you I've been
out of the office for a couple of days. When I run the
first bit of code it returns "(local)" and that's it
In my SQL code I refer to the two SQL databases I have as
YOUR-HPBMYE9TMB.SUNDB and
YOUR-HPBMYE9TMB.SUNDB426
So expected to see the YOUR-HPBMYE9TMB bit appear, only
got "(local)" though. Any ideas?
Thank you
Matt
>.
>
> When I run the
> first bit of code it returns "(local)" and that's it
>
> In my SQL code I refer to the two SQL databases I have as
>
> YOUR-HPBMYE9TMB.SUNDB and
> YOUR-HPBMYE9TMB.SUNDB426
>
> So expected to see the YOUR-HPBMYE9TMB bit appear, only
> got "(local)" though. Any ideas?
OK, (local) will be the SQL Server on your local machine and I assume
by
YOUR-HPBMYE9TMB
you mean owner. Now try the following code. Set the reference to
SQLDMO; early binding will allow you to set a breakpoint and peruse
the many interest objects/properties (save your work first - this
hanged on!) Don't forget to change the UID and password to suit:
Sub Test2
' Early bound
' Requires reference to
' Microsoft SQLDMO Object Library
Dim qServer As SQLDMO.SQLServer
Dim qDatabase As SQLDMO.Database
Dim strServer As String
Dim strUID As String
Dim strPassword As String
strServer = "(local)"
strUID = "sa"
strPassword = ""
Set qServer = New SQLDMO.SQLServer
With qServer
.Connect strServer, strUID, strPassword
For Each qDatabase In .Databases
Debug.Print _
qDatabase.Properties("Username").Value & _
"." & qDatabase.Name
Next
End With
Set qServer = Nothing
End Sub
--
Regardless thank you very much indeed for all that so
far. It's solved the most important part of my problem.
Cheers
Matt
Sub ListofSQLServerNames()
Dim oSqlApp As Object
Dim SQLServerNames As Variant
Dim qServer As SQLDMO.SQLServer
Dim qDatabase As SQLDMO.Database
Dim strServer As String
Dim strUID As String
Dim strPassword As String
Dim ListofSQLServerNames
Set oSqlApp = CreateObject("SQLDMO.Application")
With oSqlApp
For Each SQLServerNames In .ListAvailableSQLServers
strUID = "SUN"
strPassword = "SUNSYS"
Set qServer = New SQLDMO.SQLServer
With qServer
.Connect SQLServerNames, strUID, strPassword
On Error Resume Next 'This stops the code
failing where the STRUID / strPassword Combo in incorrect
For Each qDatabase In .Databases
ListofSQLServerNames = qDatabase.Properties
("Username").Value & _
"." & qDatabase.Name & vbCr &
ListofSQLServerNames
Next
End With
On Error GoTo 0
Set qServer = Nothing
Next
End With
MsgBox "The list of SQL Server Databases that you can
access with that Login / Password " & _
"combinations is as follows: " & vbCr & vbCr &
ListofSQLServerNames
End Sub
>.
>
> Wicked!!
> Thanks onedaywhen, that's taught me a lot.
Glad to hear it.
> To be a bit cheeky and ask for more? Is there any
> way of listing these options so that a user can select
> one of them and have it land it a cell?
The are too many ways of doing this to generalize.
A sentence, instead of a Sub which builds a string, make
ListofSQLServerNames a function which returns a string array:
Public Function ListofSQLServerNames() As Variant
which you can associate the List property of a ComboBox on a userform
or worksheet e.g.
MyListbox.List = ListofSQLServerNames()
Post some more details for an in-depth answer.
--
Thanks for all your help
Did some searching and ended up with below
Thanks again
Regards
Matt
Went with :
Range("SQL_Database_Name").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=ListofSQLServerNames
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
>.
>