defining Column Reference with ADO connections using VBA

[NBVC]

Hi, does anyone know about ADO connections to Databases using VBA?

I have this code that works well.

It extracts Employee ID's and there Names from our database and lists them in columns A:C

What I want to do is list the ID's manually and get it to extract only the Names for the ID's I listed in Column A...

I am not sure how to amend this code to look at ID's listed in column A instead of extracting the whole database.

I know I need to add a "WHERE ID =" clause in the SQL but not sure how to say WHERE ID = A1, A2, etc...

Thanks.

Here's the code that works at extracting the whole database (it's not mine...I don't remember where on the web I found it):

Option Explicit

Sub Button1_Click()


'Defining variables
Dim cnOra As ADODB.Connection
Dim rsOra As ADODB.Recordset
Dim db_name As String
Dim UserName As String
Dim Password As String
Dim i As Long

Set cnOra = New ADODB.Connection
Set rsOra = New ADODB.Recordset

db_name = "SANDBOX_ODBC"
UserName = "SYSADM"
Password = "SYSADM"

'Making an ODBC connection according to ADO
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
rsOra.CursorLocation = adUseServer

'Running a query
rsOra.Open "Select ID, FIRST_NAME, LAST_NAME from EMPLOYEE", cnOra, adOpenForwardOnly

'Passing on data from the recordset to a variable or cell.
'Notice that the column name or alias is used to address
'data in the recordset.
i = 1
While Not rsOra.EOF
Worksheets("sheet1").Range("A" & i) = rsOra![ID]
Worksheets("sheet1").Range("B" & i) = rsOra![FIRST_NAME]
Worksheets("sheet1").Range("C" & i) = rsOra![LAST_NAME]
rsOra.MoveNext
i = i + 1
Wend

rsOra.Close
rsOra.Open "select sysdate from dual", cnOra, adOpenForwardOnly

While Not rsOra.EOF
Worksheets("Sheet1").Range("E2") = rsOra![sysdate]
rsOra.MoveNext
Wend

'Forgetting to close your connection will sometimes result in
'Dr.Watsons
rsOra.Close
cnOra.Close
Set rsOra = Nothing

End Sub

[Richard Schollar]

Hi Vittorio

Assuming you have the IDs listed in col A of Sheet1 starting from A2 then you need to build up a string to hold the various IDs. Do this first by extrcating the IDs into a variant array:

Dim vIDs As Variant

With Sheets("Sheet1")
  vIDs = .Range("A2:A" & .Cells(.Rows.Count,"A").End(xlUp).Row).Value
End With

Next we need to convert this variant array of IDs into a string of IDs bounded by single-quotes and commas:

Dim strIDs As String

strIDs = Join(Application.WorksheetFunction.Transpose(vIDs),"','")

'add the first ' and last ':

strIDs = "'" & strIDs & "'"

Now you have your list, you need to incorporate into your SQL string. The SQL operator IN is the one you want to use, as you have multiple values:

rsOra.Open "Select ID, FIRST_NAME, LAST_NAME from EMPLOYEE Where ID In(" & strIDs & ") ", cnOra, adOpenForwardOnly

Note that I think there is an upper limit to how longg strings can be when using the Open method of the Recordset object (with ADO). If you do run into this barrier, you can get around it, I believe) by using the ADO command object.

Another thing is I have assumed your IDs are textual above - if this is not the case and they are simply numeric numbers then you probably won't need the singlwe quotes around all the values.

Richard

[NBVC]

Hi Richard,

Thank you very much for coming to my aid. It is much appreciated!

This seems to have worked, except that it seems to reorder the results...

i.e. the results do not line up with the corresponding actual IDs listed in column A.

They seem to come out as the though the ID's have been sorted.?

Any way to fix this?

[Richard Schollar]

Well, you could use the Find method of the recordset object to loop thru the recordset and return the specific results. Let's say your IDs in the A column are contained in range variable rngIDs:

'you have already set a range ref to create rngIDs
'Open recordset with the following:

rsOra.CursorLocation = adUseClient

'strSQL as defined with the IN and the parameter string (called strSQL, cos I cant be bothered writing it out!)
rsOra.Open strSQL, cnOra, adOpenStatic



For Each c in rngIDs
  With rsOra
    .Find "ID = '" & c.Value & "'"
    If Not .EOF Then
      c.Offset(0,1).Value = ![FIRST_NAME]
      c.Offset(0,1).Value = ![LAST_NAME]
    End If
    .MoveFirst
   End With
Next c

Richard

[NBVC]

Hi Richard,

You kinda' lost me here...sorry.

Am I replacing code or adding code?

Is rngIDs the same thing as vIDs or strIDs?

[NBVC]

Okay Richard...

I think I've got it....

This is the working code:

Option Explicit

Sub Button1_Click()


'Defining variables
Dim cnOra As ADODB.Connection
Dim rsOra As ADODB.Recordset
Dim db_name As String
Dim UserName As String
Dim Password As String
Dim vIDs As Variant
Dim strIDs As String
Dim c As Range
Dim rngIDs As Range

Dim i As Long

Set cnOra = New ADODB.Connection
Set rsOra = New ADODB.Recordset

db_name = "SANDBOX_ODBC"
UserName = "SYSADM"
Password = "SYSADM"

'Making an ODBC connection according to ADO
cnOra.Open "DSN=" + db_name + ";UID=" + UserName + ";PWD=" & Password + ";"
rsOra.CursorLocation = adUseServer


With Sheets("Sheet1")
  vIDs = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With

strIDs = Join(Application.WorksheetFunction.Transpose(vIDs), "','")

'add the first ' and last ':

strIDs = "'" & strIDs & "'"

'Running a query

rsOra.Open "Select ID, FIRST_NAME, LAST_NAME from EMPLOYEE Where ID In(" & strIDs & ") ", cnOra, adOpenStatic

Set rngIDs = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp))

For Each c In rngIDs
  With rsOra
    .Find "ID = '" & c.Value & "'"
    If Not .EOF Then
      c.Offset(0, 1).Value = rsOra![FIRST_NAME]
      c.Offset(0, 2).Value = rsOra![LAST_NAME]
    End If
    .MoveFirst
   End With
Next c


'Forgetting to close your connection will sometimes result in Dr.Watsons
rsOra.Close
cnOra.Close
Set rsOra = Nothing

End Sub

The only thing now is that it runs very slow as it goes through each line....

I am asking too much if I ask if it can sped up a bit in any way?