Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Retrieving querytable parameter values and locations
Hello all,
I'm new to Excel VBA programming but not new to programming. I've been asked to fix an Excel template that creates a querytable via ODBC and its parameters on a specified worksheet. Since I might be linking to a worksheet that already has a querytable on it I decided to take it one step further. I want to read the parameter names, values and locations from the querytable and display them in the template. I'm using the SourceRange property of the Parameter to find the address and Row/Col to find the value. It works as long as the querytable and parameters are on the same worksheet or if the querytable is on Sheet1 and the parameters are on Sheet1 or Sheet2. If any parameteris on Sheet3 the SourceRange property is undefined for that parameter (weird). Any help would be greatly appreciated. Code below. Sub CreateQueryTable() Dim iQueryTableName, iWorkbook, iworksheet, iRng As Variant Dim oWB As Workbook, oWS As Worksheet, pWS As Worksheet Dim ODBC_CONNECTION_STRING As String Dim strQuery As String Dim oRange As Range Dim Param As Parameter Dim i As Integer, pName As String, ptype As String, pSheet As String, pRange As String Dim pSheet_old, pName_old As String Dim qData As QueryTable iQueryTableName = Range("Query_Table_Name").Value iWorkbook = Range("Workbook").Value iworksheet = Range("Worksheet").Value iRng = Range("Range").Value On Error GoTo W: Set oWB = Workbooks(iWorkbook) On Error GoTo S: Set oWS = Workbooks(iWorkbook).Sheets(iworksheet) 'Search the specified worksheet for the query table name 'If it's not there create it For Each qt In oWS.QueryTables If qt.Name = iQueryTableName Then 'Instead of erasing the previous querytable I'm going to 'update it instead using the CommandText method On Error Resume Next 'If the Query Table exists just clear the contents oWS.QueryTables(iQueryTableName).ResultRange.Clear Contents Set qData = qt Exit For ' Else ' 'If you want to create a new query table name you will be stuck 'with the old one on the same spreadsheet. There's no way to distinquish a previous 'query table name from another query table on the same spreadsheet. ' ' 'erase the previous query results on worksheet ' On Error Resume Next ' oWS.Range(qt.Name).Clear ' ' 'delete the querytable range name on worksheet ' On Error Resume Next ' oWS.Names(qt.Name).Delete ' ' 'delete the querytable object ' On Error Resume Next ' qt.Delete End If Next qt 'If query table isn't there then create it otherwise update the SQL and delete the parameters If qData Is Nothing Then On Error GoTo W: ODBC_CONNECTION_STRING = Range("ODBC_CONNECTION_STRING").Value On Error GoTo r: Set oRange = oWS.Range(iRng) On Error GoTo Q: strQuery = Range("SQL_Text").Value Set qData = oWS.QueryTables.Add(Connection:=ODBC_CONNECTION_ST RING, Destination:=oRange, Sql:=strQuery) Else On Error GoTo Q: qData.CommandText = Range("SQL_Text").Value qData.Parameters.Delete End If With qData i = 1 pName = Range("Parameter_Name").Offset(i, 0).Value Do While pName < "" ptype = Range("Parameter_Name").Offset(i, 1).Value pSheet = Range("Parameter_Name").Offset(i, 2).Value pRange = Range("Parameter_Name").Offset(i, 3).Value ' If Param Is Nothing Or pName < pName_old Then Set Param = .Parameters.Add(pName, GetTypeOf(ptype)) ' End If ' If pWS Is Nothing Or pSheet < pSheet_old Then Set pWS = Workbooks(iWorkbook).Sheets(pSheet) ' End If Param.SetParam xlRange, pWS.Range(pRange) i = i + 1 ' pName_old = pName pName = Range("Parameter_Name").Offset(i, 0).Value ' pSheet_old = pSheet Set Param = Nothing Set pWS = Nothing Loop .Name = iQueryTableName .BackgroundQuery = False .RefreshOnFileOpen = Sheets("Options").Range("RefreshOnFileOpen").Value .SavePassword = Sheets("Options").Range("SavePassword").Value .SaveData = Sheets("Options").Range("SaveData").Value .FieldNames = Sheets("Options").Range("FieldNames").Value .PreserveFormatting = Sheets("Options").Range("PreserveFormatting").Valu e .AdjustColumnWidth = Sheets("Options").Range("AdjustColumnWidth").Value .RowNumbers = Sheets("Options").Range("RowNumbers").Value .PreserveColumnInfo = Sheets("Options").Range("PreserveColumnInfo").Valu e .FillAdjacentFormulas = Sheets("Options").Range("FillAdjacentFormulas").Va lue .HasAutoFormat = Sheets("Options").Range("HasAutoFormat").Value .RefreshStyle = GetRefreshStyle(Sheets("Options").Range("RefreshSt yle").Value) .Refresh Range("Query_Table_Name").Value = .Name End With Set oWS = Nothing Set oRange = Nothing Set Param = Nothing Set oWB = Nothing Set pWS = Nothing Set qData = Nothing ' cmdParameters.Visible = True ' cmdSQLString.Visible = True ' cmdResetParameters.Visible = True Exit Sub 'Find the parameters Private Sub cmdParameters_Click() Dim i, j As Integer Dim qtp As Parameter Dim ptype, pSheet, pName As String Dim iQueryTableName, iWorkbook, iworksheet, iRng As String Dim oWB As Workbook, oWS As Worksheet, tWS As Worksheet Dim r As Range On Error GoTo ERROR: iQueryTableName = Range("Query_Table_Name").Value iWorkbook = Range("Workbook").Value iworksheet = Range("Worksheet").Value 'Get the WorkBook that the query table is contained in Set oWB = Workbooks(iWorkbook) 'Get the WorkSheet that the query table is on Set oWS = Workbooks(iWorkbook).Sheets(iworksheet) 'Clear parameter range Range(Range("Parameter_Name").Offset(1, 0).Address, Range("ParameterNameEnd").Address).ClearContents i = 1 For Each qtp In oWS.QueryTables(iQueryTableName).Parameters Select Case qtp.DataType Case xlParamTypeBigInt ptype = "xlParamTypeBigInt" Case xlParamTypeBinary ptype = "xlParamTypeBinary" Case xlParamTypeBit ptype = "xlParamTypeBit" Case xlParamTypeChar ptype = "xlParamTypeChar" Case xlParamTypeDate ptype = "xlParamTypeDate" Case xlParamTypeDecimal ptype = "xlParamTypeDecimal" Case xlParamTypeDouble ptype = "xlParamTypeDouble" Case xlParamTypeFloat ptype = "xlParamTypeFloat" Case xlParamTypeInteger ptype = "xlParamTypeInteger" Case xlParamTypeLongVarBinary ptype = "xlParamTypeLongVarBinary" Case xlParamTypeLongVarChar ptype = "xlParamTypeLongVarChar" Case xlParamTypeNumeric ptype = "xlParamTypeNumeric" Case xlParamTypeReal ptype = "xlParamTypeReal" Case xlParamTypeSmallInt ptype = "xlParamTypeSmallInt" Case xlParamTypeTime ptype = "xlParamTypeTime" Case xlParamTypeTimestamp ptype = "xlParamTypeTimestamp" Case xlParamTypeTinyInt ptype = "xlParamTypeTinyInt" Case xlParamTypeUnknown ptype = "xlParamTypeUnknown" Case xlParamTypeVarBinary ptype = "xlParamTypeVarBinary" Case xlParamTypeVarChar ptype = "xlParamTypeVarChar" Case xlParamTypeWChar ptype = "xlParamTypeWChar" Case Else ptype = "UNKNOWN" End Select 'From the Query Table get the range object Set r = oWS.QueryTables(iQueryTableName).Parameters(i).Sou rceRange Set tWS = Workbooks(iWorkbook).Sheets(r.Worksheet.CodeName) Set tWS = Workbooks(iWorkbook).Sheets(r.Worksheet.CodeName) 'Parameter Name Range("Parameter_Name").Offset(i, 0).Value = qtp.Name 'Parameter Type Range("Parameter_Name").Offset(i, 1).Value = ptype 'Worksheet Range("Parameter_Name").Offset(i, 2).Value = r.Worksheet.CodeName 'Cell Location Range("Parameter_Name").Offset(i, 3).Value = tWS.Cells(r.Row, r.Column).Address 'Parameter Value Range("Parameter_Name").Offset(i, 4).Value = tWS.Cells(r.Row, r.Column).Value 'Gray Background Range("Parameter_Name").Offset(i, 4).Select With Selection.Interior .ColorIndex = 15 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With i = i + 1 ' ActiveCell.Offset(1, 0).EntireRow.Insert ' ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow Set r = Nothing Set tWS = Nothing Next qtp Set r = Nothing Set oWB = Nothing Set oWS = Nothing Set qtp = Nothing Exit Sub ERROR: Set r = Nothing Set oWB = Nothing Set oWS = Nothing Set qtp = Nothing MsgBox ("Parameter Not Found. Please check Workbook/Worksheet/Query table name given for accuracy.") Exit Sub End Sub EggHeadCafe.com - .NET Developer Portal of Choice http://www.eggheadcafe.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Retrieving values from another sheet | Excel Worksheet Functions | |||
Help with Comparing values and retrieving values in Excel!!!!!! | Excel Worksheet Functions | |||
retrieving values from a specified sheet | Excel Worksheet Functions | |||
Retrieving VLookup Values | Excel Programming | |||
QueryTable OLE DB with Parameter | Excel Programming |