How to populate VBA Variables from ADODB.Connection Results?

D

Damian Carrillo

I'm trying to retrieve information based on the active user. First I
need to lookup data in SQL Server based on the one piece of
information I know about the user opening the document: Their Network
Login. I gather this information using the ADODB.Connection &
ADODB.RecordSet. The problem I'm having is how to get the information
from the ADODB.RecordSet into the array I created to hold various info
about the user. Help?

For x = 0 To 5
Let SQLquery = QueryUserInfo(x) 'Define source query
Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve query value
Let UserInfo(x) = RecSet 'Populate value into field
Next x

The full code is below. From the user information gained I construct
a query to pull data from SQL Server into the Excel spreadsheet using
the native ActiveSheet.QueryTables.Add method. This second function I
am able to make work but only if I hardcode the values in UserInfo(0
to 5) like I hard coded QueryUserInfo(0 to 5).

'-------------------------------------------------------
Option Explicit

Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim UserName As String

'-------------------------------------------------------
Function CurrentUserName() As String
UserName = Space(255)
GetUserName UserName, 255
UserName = Left(UserName, InStr(UserName, Chr(0)) - 1)
CurrentUserName = UserName
End Function

'-------------------------------------------------------
Sub RetrieveNPGHeadcountFromCMSLive()
'Import Data From SQL Server to populate headcount table based on the
office
'and department of the user opening the spreadsheet as populated from
QueryCommandText.

Dim Conn As ADODB.Connection 'SQL Server Connection
Dim RecSet As ADODB.Recordset 'SQL Server RecordSet
Dim SQLquery As String 'SQL Server Query holder
Dim ActiveUser As String 'Holds login information for looking up
other values
Dim QueryUserInfo(0 To 5) As Variant 'Field Queries For: EmpID,
EmpName, Offc, Dept, Login, Position
Dim UserInfo(0 To 5) As String 'Field Values: EmpID, EmpName,
Offc, Dept, Login, Position
Dim QueryCommandText As String 'SQL Server query to retrieve
ultimate target data set
Dim x As Integer, y As Integer 'Incremental counters to populate
QueryUserInfo and UserInfo arrays

Let ActiveUser = CurrentUserName
Let QueryUserInfo(0) = "SELECT EMPLOYEE_CODE FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let QueryUserInfo(1) = "SELECT EMPLOYEE_NAME FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let QueryUserInfo(2) = "SELECT OFFC FROM HBM_PERSNL WHERE LOGIN ="
& " '" & ActiveUser & "'"
Let QueryUserInfo(3) = "SELECT DEPT FROM HBM_PERSNL WHERE LOGIN ="
& " '" & ActiveUser & "'"
Let QueryUserInfo(4) = "SELECT LOGIN FROM HBM_PERSNL WHERE LOGIN
=" & " '" & ActiveUser & "'"
Let QueryUserInfo(5) = "SELECT POSITION FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let x = 0 And y = 0

'Find SQL Server data for the active user. This data is used in
the main QueryCommandText statement
Set Conn = New ADODB.Connection
Conn.Open "seassql08", "administrator", "[*****]"
For x = 0 To 5
Let SQLquery = QueryUserInfo(x) 'Define source query
Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve query value
Let UserInfo(x) = RecSet 'Populate value into field
Next x
RecSet.Close
Conn.Close

Let QueryCommandText = "SELECT HBM_PERSNL.EMPLOYEE_CODE as EmpID,
HBM_PERSNL.EMPLOYEE_NAME as EmpName," & " " & _
"HBM_PERSNL.OFFC as Offc, HBM_PERSNL.DEPT
as Dept, HBM_PERSNL.LOCATION as Loc," & " " & _
"HBM_PERSNL.LOGIN as Login,
HBM_PERSNL.PHONE_NO as Phone, HBM_PERSNL.POSITION as Position," & " "
& _
"HBL_PERSNL_TYPE.PERSNL_TYP_CODE as
TypeID, HBL_PERSNL_TYPE.PERSNL_TYP_DESC as TypeName," & " " & _
"TBM_PERSNL.RANK_CODE as Rank,
TBM_PERSNL.PARTIME_PCNT as FTE" & " " & _
"FROM (dbo.HBM_PERSNL INNER JOIN
HBL_PERSNL_TYPE ON" & " " & _
"dbo.HBM_PERSNL.PERSNL_TYP_CODE =
HBL_PERSNL_TYPE.PERSNL_TYP_CODE)" & " " & _
"INNER JOIN TBM_PERSNL ON
TBM_PERSNL.EMPL_UNO = dbo.HBM_PERSNL.EMPL_UNO" & " " & _
"WHERE HBM_PERSNL.INACTIVE='N' and
HBM_PERSNL.PERSNL_TYP_CODE NOT IN ('PERKI','RESR')" & " " & _
"and HBM_PERSNL.LOGIN NOT IN
('','15REC','ZZZZA','EVENTS','SPALA','PZZZX','DCGU1','INTAPPADMIN','LAGU1','TECHS','DR0NE')"
& " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'%TEMP%' and
HBM_PERSNL.LOGIN NOT LIKE'TRANS%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'TRON%' and
HBM_PERSNL.LOGIN NOT LIKE'POGU%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'BIT%' and
HBM_PERSNL.LOGIN NOT LIKE'DPC%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'PERK%' and
HBM_PERSNL.LOGIN NOT LIKE'CMS%'" & " " & _
"and HBM_PERSNL.DEPT IN('" & UserInfo(3) &
"') --and HBM_PERSNL.OFFC IN('02','03')" & " " & _
"ORDER BY HBM_PERSNL.OFFC,
HBM_PERSNL.DEPT, HBM_PERSNL.EMPLOYEE_NAME"

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _

"ODBC;DSN=seassql08;Description=seassql08;UID=administrator;PWD=
[*****];APP=Microsoft Office
2003;WSID=SEAD502366;Network=DBMSSOCN;Address=se" _
), Array("assql08,1433")), Destination:=Range("A5"))
.CommandText = QueryCommandText
.Name = "Query from seassql08"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
'-------------------------------------------------------
 
J

Joel

I made some changes in your SQL statement. Here is the portion of your code
I changed

Dim x As Integer, y As Integer 'Incremental counters to populate
'QueryUserInfo and UserInfo arrays

Let ActiveUser = CurrentUserName
Let MySelect = "SELECT EMPLOYEE_CODE FROM HBM_PERSNL, " & _
"SELECT EMPLOYEE_NAME FROM HBM_PERSNL, " & _
"SELECT OFFC FROM HBM_PERSNL, " & _
"SELECT DEPT FROM HBM_PERSNL, " & _
"SELECT LOGIN FROM HBM_PERSNL, " & _
"SELECT POSITION FROM HBM_PERSNL, "
Let Mywhere = "WHERE LOGIN = '" & ActiveUser & "'"
Let SQLquery = MySelect & vbCrLf & Mywhere

Let x = 0 And y = 0

'Find SQL Server data for the active user. This data is used in
'the main QueryCommandText statement

Set Conn = New ADODB.Connection
Conn.Open "seassql08", "administrator", "[*****]"
For x = 0 To 5

Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve query value
UserInfo(x) = RecSet.Fields.Item(x).Value
Next x
RecSet.Close
Conn.Close


Damian Carrillo said:
I'm trying to retrieve information based on the active user. First I
need to lookup data in SQL Server based on the one piece of
information I know about the user opening the document: Their Network
Login. I gather this information using the ADODB.Connection &
ADODB.RecordSet. The problem I'm having is how to get the information
from the ADODB.RecordSet into the array I created to hold various info
about the user. Help?

For x = 0 To 5
Let SQLquery = QueryUserInfo(x) 'Define source query
Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve query value
Let UserInfo(x) = RecSet 'Populate value into field
Next x

The full code is below. From the user information gained I construct
a query to pull data from SQL Server into the Excel spreadsheet using
the native ActiveSheet.QueryTables.Add method. This second function I
am able to make work but only if I hardcode the values in UserInfo(0
to 5) like I hard coded QueryUserInfo(0 to 5).

'-------------------------------------------------------
Option Explicit

Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim UserName As String

'-------------------------------------------------------
Function CurrentUserName() As String
UserName = Space(255)
GetUserName UserName, 255
UserName = Left(UserName, InStr(UserName, Chr(0)) - 1)
CurrentUserName = UserName
End Function

'-------------------------------------------------------
Sub RetrieveNPGHeadcountFromCMSLive()
'Import Data From SQL Server to populate headcount table based on the
office
'and department of the user opening the spreadsheet as populated from
QueryCommandText.

Dim Conn As ADODB.Connection 'SQL Server Connection
Dim RecSet As ADODB.Recordset 'SQL Server RecordSet
Dim SQLquery As String 'SQL Server Query holder
Dim ActiveUser As String 'Holds login information for looking up
other values
Dim QueryUserInfo(0 To 5) As Variant 'Field Queries For: EmpID,
EmpName, Offc, Dept, Login, Position
Dim UserInfo(0 To 5) As String 'Field Values: EmpID, EmpName,
Offc, Dept, Login, Position
Dim QueryCommandText As String 'SQL Server query to retrieve
ultimate target data set
Dim x As Integer, y As Integer 'Incremental counters to populate
QueryUserInfo and UserInfo arrays

Let ActiveUser = CurrentUserName
Let QueryUserInfo(0) = "SELECT EMPLOYEE_CODE FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let QueryUserInfo(1) = "SELECT EMPLOYEE_NAME FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let QueryUserInfo(2) = "SELECT OFFC FROM HBM_PERSNL WHERE LOGIN ="
& " '" & ActiveUser & "'"
Let QueryUserInfo(3) = "SELECT DEPT FROM HBM_PERSNL WHERE LOGIN ="
& " '" & ActiveUser & "'"
Let QueryUserInfo(4) = "SELECT LOGIN FROM HBM_PERSNL WHERE LOGIN
=" & " '" & ActiveUser & "'"
Let QueryUserInfo(5) = "SELECT POSITION FROM HBM_PERSNL WHERE
LOGIN =" & " '" & ActiveUser & "'"
Let x = 0 And y = 0

'Find SQL Server data for the active user. This data is used in
the main QueryCommandText statement
Set Conn = New ADODB.Connection
Conn.Open "seassql08", "administrator", "[*****]"
For x = 0 To 5
Let SQLquery = QueryUserInfo(x) 'Define source query
Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve query value
Let UserInfo(x) = RecSet 'Populate value into field
Next x
RecSet.Close
Conn.Close

Let QueryCommandText = "SELECT HBM_PERSNL.EMPLOYEE_CODE as EmpID,
HBM_PERSNL.EMPLOYEE_NAME as EmpName," & " " & _
"HBM_PERSNL.OFFC as Offc, HBM_PERSNL.DEPT
as Dept, HBM_PERSNL.LOCATION as Loc," & " " & _
"HBM_PERSNL.LOGIN as Login,
HBM_PERSNL.PHONE_NO as Phone, HBM_PERSNL.POSITION as Position," & " "
& _
"HBL_PERSNL_TYPE.PERSNL_TYP_CODE as
TypeID, HBL_PERSNL_TYPE.PERSNL_TYP_DESC as TypeName," & " " & _
"TBM_PERSNL.RANK_CODE as Rank,
TBM_PERSNL.PARTIME_PCNT as FTE" & " " & _
"FROM (dbo.HBM_PERSNL INNER JOIN
HBL_PERSNL_TYPE ON" & " " & _
"dbo.HBM_PERSNL.PERSNL_TYP_CODE =
HBL_PERSNL_TYPE.PERSNL_TYP_CODE)" & " " & _
"INNER JOIN TBM_PERSNL ON
TBM_PERSNL.EMPL_UNO = dbo.HBM_PERSNL.EMPL_UNO" & " " & _
"WHERE HBM_PERSNL.INACTIVE='N' and
HBM_PERSNL.PERSNL_TYP_CODE NOT IN ('PERKI','RESR')" & " " & _
"and HBM_PERSNL.LOGIN NOT IN
('','15REC','ZZZZA','EVENTS','SPALA','PZZZX','DCGU1','INTAPPADMIN','LAGU1','TECHS','DR0NE')"
& " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'%TEMP%' and
HBM_PERSNL.LOGIN NOT LIKE'TRANS%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'TRON%' and
HBM_PERSNL.LOGIN NOT LIKE'POGU%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'BIT%' and
HBM_PERSNL.LOGIN NOT LIKE'DPC%'" & " " & _
"and HBM_PERSNL.LOGIN NOT LIKE'PERK%' and
HBM_PERSNL.LOGIN NOT LIKE'CMS%'" & " " & _
"and HBM_PERSNL.DEPT IN('" & UserInfo(3) &
"') --and HBM_PERSNL.OFFC IN('02','03')" & " " & _
"ORDER BY HBM_PERSNL.OFFC,
HBM_PERSNL.DEPT, HBM_PERSNL.EMPLOYEE_NAME"

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _

"ODBC;DSN=seassql08;Description=seassql08;UID=administrator;PWD=
[*****];APP=Microsoft Office
2003;WSID=SEAD502366;Network=DBMSSOCN;Address=se" _
), Array("assql08,1433")), Destination:=Range("A5"))
.CommandText = QueryCommandText
.Name = "Query from seassql08"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
'-------------------------------------------------------
Click to expand...
 
D

Damian Carrillo

I made some changes in your SQL statement.  Here is the portion of yourcode
I changed

    Dim x As Integer, y As Integer 'Incremental counters to populate
'QueryUserInfo and UserInfo arrays

    Let ActiveUser = CurrentUserName
    Let MySelect = "SELECT EMPLOYEE_CODE FROM HBM_PERSNL, " & _
                   "SELECT EMPLOYEE_NAME FROM HBM_PERSNL, " & _
                   "SELECT OFFC FROM HBM_PERSNL, " & _
                   "SELECT DEPT FROM HBM_PERSNL, " & _
                   "SELECT LOGIN FROM HBM_PERSNL, " &_
                   "SELECT POSITION FROM HBM_PERSNL, "
    Let Mywhere = "WHERE LOGIN = '" & ActiveUser & "'"
    Let SQLquery = MySelect & vbCrLf & Mywhere

    Let x = 0 And y = 0

    'Find SQL Server data for the active user. This data is used in
    'the main QueryCommandText statement

    Set Conn = New ADODB.Connection
    Conn.Open "seassql08", "administrator", "[*****]"
    For x = 0 To 5

       Set RecSet = Conn.Execute(SQLquery, , 1) 'Retrieve queryvalue
       UserInfo(x) = RecSet.Fields.Item(x).Value
    Next x
    RecSet.Close
    Conn.Close
Click to expand...

Joel,

I'm unable to get your code to work. There's two problems. The
first, MySelect and MyWhere aren't declared values. I assumed them to
be strings, but then ran into the second problem: an ODBC SQL Server
Driver error "Incorrect syntax near the keyword Select. I'm guessing
its because we're trying to send multiple selects in a single
statement without encapsulation. Or maybe because we're trying to send
vbCrLf in the statement but it needs to be a single string.

So instead I tried to adapt your code back to my original code,
changing only the line:

UserInfo(x) = RecSet
TO
Let UserInfo(x) = RecSet.Fields.Item(x).Value

This worked for the first field (EMPLOYEE_CODE) but the
RecSet.Fields.Item(x).Value failed after the first loop through the
FOR...NEXT statement.

-Damian
 
D

Damian Carrillo

Joel,
I'm unable to get your code to work.  There's two problems.  The
first, MySelect and MyWhere aren't declared values. I assumed them to
be strings, but then ran into the second problem: an ODBC SQL Server
Driver error "Incorrect syntax near the keyword Select.  I'm guessing
its because we're trying to send multiple selects in a single
statement without encapsulation. Or maybe because we're trying to send
vbCrLf in the statement but it needs to be a single string.

So instead I tried to adapt your code back to my original code,
changing only the line:

       UserInfo(x) = RecSet
TO
       Let UserInfo(x) = RecSet.Fields.Item(x).Value

This worked for the first field (EMPLOYEE_CODE) but the
RecSet.Fields.Item(x).Value failed after the first loop through the
FOR...NEXT statement.

-Damian
Click to expand...

Okay I figured it out. I used my old code with your statement

Let UserInfo(x) = RecSet.Fields.Item(0).Value

Changing the Item(x) to Item(0) fixed the problem. So in the end your
effort helped me. Thanks Joel!

-Damian
 
J

Joel

I think my code had a probelm with an extra comma at the end of the select
statement

from
"SELECT POSITION FROM HBM_PERSNL, "
to
"SELECT POSITION FROM HBM_PERSNL"

Since I didn't have your database I tried similar code from my PC using a
mdb access database. The code worked. I thought doing one SQL query was
more efficient than doing 5 sql reuests.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Stubborn Array won't Populate from single ADODB.Connection Query 4
Retrieving Data from SQL Server to Excel 1
VBA to export large tables from Excel to SQL Server 1
VBA to SQL DB with user input and results to worksheet 4
fill a web form from excel vba 3
A macro to authorize a user to run another macro. 0
Stored procedure in SQL + vba to return a subset in Excel based onLIKE %varchar% clause 7
ADO to pull data from Access query 3

Top