Convert sub to function - prompt not appearing in formula bar

[theta]

Hi all...trying and failing to convert this sub to a function that can be called from code / worksheet.

I would like to define the Initial Catalog, Data Source, SQL string and Destination for the data.

When I tried to convert it to a function, I would expect typing =SQLADO( into the formula bar would yield the field menu showing what fields are required, but this is not the case e.g.

=VLOOKUP( > lookup_table, table_array etc

This is the original sub, with RED highlighted areas I would like to send to the function as variables :

[vba]
Sub SQLADO()

Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stSQL As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnStart As Range


Const stADO As String = "Provider=SQLOLEDB;Integrated Security=SSPI;" & _
"Persist Security Info=False;" & _
"Initial Catalog=DATABASE;" & _
"Data Source=SERVER"

Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)

With wsSheet
Set rnStart = .Range("A1")
End With

stSQL = "SELECT * FROM COUNTRIES"

Set cnt = New ADODB.Connection

With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst = .Execute(stSQL)
End With

'Here we add the Recordset to the sheet from A1
rnStart.CopyFromRecordset rst

'Cleaning up.
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing

End Sub

[/vba]

Any help appreciated

[Bob Phillips]

Wouldn't it just be

[VBA]Public Function SQLADO(Server As String, DB As String, SQL As String)

Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stSQL As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnStart As Range


Const stADO As String = "Provider=SQLOLEDB;Integrated Security=SSPI;" & _
"Persist Security Info=False;" & _
"Initial Catalog=" & DB & ";" & _
"Data Source=" & Server

Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)

With wsSheet
Set rnStart = .Range("A1")
End With

Set cnt = New ADODB.Connection

With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst = .Execute(SQL)
End With

'Here we add the Recordset to the sheet from A1
rnStart.CopyFromRecordset rst

'Cleaning up.
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing

End Function[/VBA]

[GTO]

...better answer already posted :-)

[theta]

But when I go into the workbook and type the function name I would expect to see a tooltip prompt showing what variables are expected (like when you type =VLOOKUP( you get lookup_array) :

=SQLADO(Server As String, DB As String, SQL As String)

Instead I get nothing... ?

[Bob Phillips]

You just don't get those with UDFs.

[theta]

I get an error with the line containing "DB" highlighted - requires a constant

[vba]
"Initial Catalog=" & DB & ";" & _
[/vba]

[GTO]

Hi Theta,

Probably not much help, but just in case it can get you started:
I have only run a a few examples and must carefully piece through if wanting to use ADO or uhmmm, the other one, which escapes me at the moment. So anyways, this is just at a start in the logic of passing the arguments.

'stADO' would need changed to a variable, so that you can replace 'DATABASE' and 'SERVER'.

I would probably elect to run by codename or at least by sheetname, rather than index (for changing '1').

Similarly (at least sort of), I would send a Range or at least the Row and Column numbers, rather than 'A1'.

To get the function to be "accessible" to the formula bar, you need to declare the function at Public, and place it in a Standard Module.

By very simple exaample, in a Standard Module:
[vba]Option Explicit
Function Test(ByVal FirstString As String, ByVal SecondString As String) As String
Test = FirstString & Chr(32) & SecondString
End Function[/vba]

Now, when I type "=TEST(" and click the =/Fx button left of the formula bar, the dialog box pops up with the required arguments.

Hope that helps a bit,

Mark

PS. The ByVal's were not required, just for clarity.

[Kenneth Hobs]

You did not use what xld posted as a UDF. When you call a UDF, do not pass the variable types.

See connectionstrings.com if you need connection strings.

If you document a UDF a bit more, a Shift+F3 after = and the UDF name, use Application.MacroOptions().


Here is another example:
[vba]Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If

If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

' Check to make sure we received data and copy the data
If Not rsData.EOF Then

If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If

Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If

' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub

SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0

End Sub[/vba]

[theta]

You did not use what xld posted as a UDF. When you call a UDF, do not pass the variable types.

Hi Ken - can you explain this a bit more for my own understanding? Thanks

[GTO]

Hi Kenneth and theta,

Kudos for the question, I would certainly "second the motion", particularly as to the why we should not pas the type?

Mark

[Aflatoon]

I suspect Ken may have misinterpreted this comment:
=SQLADO(Server As String, DB As String, SQL As String)

as being how theta was calling the function, rather than showing the desired parameter popup.

[Kenneth Hobs]

As I said, you can not get a popup for a UDF that shows a comment initially after type =UDFName and after "(", all of the input parameters as you type the UDF. You can get the dialog by Ctrl+F3 as I explained which is the the same as pressing the Fx button as GTO explained. That dialog can be modified for your UDF using MacroOptions as I explained. If you want to "pass" the type of input parameters in it, then you can. An example showing how to use my UDF is commented above the UDF. You can see that we don't pass parameter types when we call it or use it as a UDF. Maybe Aflatoon has better insight than me. I don't always see things as others.

I have explained how to use MacroOptions in past threads with links to a more complex method that allows more lines and characters in that Ctrl+F3 dialog. Here is one where Aflatoon showed how to add another type of popup option (enum) that you might want to use. http://www.vbaexpress.com/forum/showthread.php?t=41472

Obviously, run MacroOptions prior to using the UDF in Ctrl+F3 or Fx.

e.g.
[vba]
Sub AddDesc_DisRangeCountIf()
Application.MacroOptions Macro:="DisRangeCountIf", _
Description:="Used like built-in function,=CountIf" & vbCrLf _
& "DisRange: Contiguous or Discontiguous range." _
& vbCrLf & "sCriteria: A string for the criteria.", _
Category:="Kens Functions"
End Sub

' =DisRangeCountIf((A1,A3:A5,A8), ">0")
Function DisRangeCountIf(ByVal DisRange As Range, ByVal sCriteria As String)
Dim dblCount As Double, cell as Range
dblCount = 0
For Each cell In DisRange.Cells
dblCount = dblCount + WorksheetFunction.CountIf(cell, sCriteria)
Next
DisRangeCountIf = dblCount
End Function
[/vba]