By using expertatexcel.com you agree to our cookie policy, We and our partners operate globally and use cookies, for multiple purposes

expertatexcel.com

 


Home
What can Excel do?
Learning Excel Books
Basic concepts Immediate window Macros 101 Syntax Use existing code Hello world Math formulas Functions Modifying Recorded Macros
Selecting Moving data Formatting Clipboard Range names Filters Sorting Fill Combining Hyperlinks Comments Options Vlookup Conditional Formatting Data validation Pivot Tables Charts Charts
Debugging Strings Active This vba statements VBA functions Run stuff
Workbook Sheet Cells Rows Column Range Selection Methods Properties Events Collections Chart
Variables Data types variables/scope Conditionals Loops functions/sub Arrays testing Batch Software dev techniques Backup/Recovery Documentation Wrappers webservice Refactor
#Errors Problems Too Slow/Optimize Error handling Problem Solving Method Someone else's sheet complex formula
Date/times Code Generation Random Shortcuts Forms Special Chars Customize your training Work and learn
Reporting Sample projects Reconcliation Adjusting data Generate Slides Special Characters
Outlook Web Database Files PPT Word API Objects Script host Dos Bloomberg JIRA Input Spreadsheets or files
Stocks Bitcoin Sports Job Productivity Project Management Tracking Health Games Programmer

CreateQueryTable - db -

Function CreateQueryTable(sSQL As String, Optional bFieldNames As Boolean, Optional loc, Optional cn, Optional QueryOrSQL, Optional p1, Optional p2, Optional p3, Optional p4) As Boolean
' Create query table from external data source.
' Takes a valid ADO connection string and a
' valid SQL SELECT statement.
' bFieldNames = true and the fieldnames are included in results
' loc = location of where to put the results, default to A1
' cn = ADODB.Connection, defaults to Fusiondaily on Jupiter

Dim sMsg  As String
'Dim cnnConnect As ADODB.Connection
Dim rstData As ADODB.Recordset
Dim qtbData As Excel.QueryTable
Dim wksNew As Excel.Worksheet

On Error GoTo CreateQueryTable_Err

If IsMissing(cn) Then
    Set cn = gADO
End If

If IsMissing(loc) Then
    Set loc = Range("A1")
End If

Set rstData = GetRecordset(sSQL, cn, QueryOrSQL, p1, p2, p3, p4)

If Err <> 0 Then
    Err.Raise Err, "", Error
    
End If


' Add new worksheet.
Set wksNew = ActiveSheet



' Create query table in new worksheet.


Set qtbData = _
wksNew.QueryTables.Add(rstData, loc)

' Refresh query table to display data.
qtbData.FieldNames = bFieldNames



qtbData.Refresh
'qtbData.RefreshPeriod = 1

CreateQueryTable = True

CreateQueryTable_End:
On Error Resume Next
rstData.Close

Set rstData = Nothing
qtbData.Delete
Set qtbData = Nothing

Exit Function

CreateQueryTable_Err:
CreateQueryTable = False
sMsg = "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & sSQL
AppMsgbox sMsg
Popup sMsg

Resume CreateQueryTable_End
Resume
End Function

Sub UseTestDB()
  gbUseProduction = False
  
    On Error Resume Next
    gADO.Close
    Set gADO = Nothing
    auto_open
    
End Sub

Function WhatDB() As String
On Error Resume Next
WhatDB = gADO.Properties(9)
If Err <> 0 Then
    WhatDB = "Not Connected"
End If

End Function