Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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','DCGU 1','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(Arra y( _ "ODBC;DSN=seassql08;Description=seassql08;UID=admi nistrator;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 '------------------------------------------------------- |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
ADODB Connection | Excel Worksheet Functions | |||
Set cnn = New ADODB.Connection | Excel Programming | |||
ADODB.Connection Error | Excel Programming | |||
ADODB.Connection | Excel Programming | |||
ADODB.Connection | Excel Programming |