fredlo2010
12-24-2014, 08:19 AM
Hello everyone and happy holidays! :)
I have a query-database question. Since this is more like and advice post I have made the questions bold.
I have a workbook that currently queries data from a database and its using procedure No1 to get the data. This gets the job don't without any problem most of the time; but sometimes when the sql takes a while to return the data Excel tends to crash.
I was think if using a ADO object combination of Connections and Recordsets will perform a little bit better. I have been using this in other macros and it's been working fine (small datasets returned).
http://msdn.microsoft.com/en-us/library/windows/desktop/ms675944%28v=vs.85%29.aspx
Will this object crash under a lot of records? I am talking about an array(200,41)
The problem with this second solution is that the headings can vary from procedure to procedure and I need the headings to identify other data.
Is there a way to create an array with the data and the headings?
Thanks a lot for your help and advice. :) :) :)
Procedure No1.
Dim oQueryTable As QueryTable
Dim strConnection As String
strConnection = "ODBC;DRIVER=SQL Server;" & _
"SERVER=myServer;" & _
"UID=myID;" & _
"PWD=myPass;" & _
"DATABASE=myDataBase"
Set oQueryTable = rDumpRange.Parent.QueryTables.Add(Connection:=strConnection, Destination:=rDumpRange)
With oQueryTable
.CommandText = QueryText
.Name = ReportName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
This is some code I have created for the ADO.
Option Explicit
Private Const m_intMYSQL As Integer = 1
Private Const m_intSQL As Integer = 2
Enum conType
conMySQL = m_intMYSQL
conSQL = m_intSQL
End Enum
Function GetConnection(eType As conType, _
ByVal strServer As String, _
ByVal strDataBase As String, _
ByVal strUser As String, _
ByVal strPassword As String) As Object
Dim oConn As Object
Dim strConn As String
On Error GoTo Error_Handler
' Instantiate the connection object
Set oConn = CreateObject("ADODB.Connection")
If eType = conMySQL Then
strConn = "Driver={MySQL ODBC 5.3 ANSI Driver};" & _
"Server=" & strServer & ";" & _
"Database=" & strDataBase & ";" & _
"User=" & strUser & ";" & _
"Password=" & strPassword & ";"
ElseIf eType = conSQL Then
strConn = "Provider=SQLOLEDB.1;" & _
"Data Source=" & strServer & ";" & _
"Initial Catalog=" & strDataBase & ";" & _
"User ID=" & strUser & ";" & _
"Password=" & strPassword & ";"
End If
' Try to open the connection.
oConn.Open strConn
Exit_Handler:
' If the connection opened succesfully return it
If oConn.State = 1 Then
Set GetConnection = oConn
Else
Set GetConnection = Nothing
End If
On Error GoTo 0
' Clean up
Set oConn = Nothing
Exit Function
Error_Handler:
' If the error is realted to the driver missing. Let the user know.
' Open internet and navigate to the code.
If Err.Number = -2147467259 Then
If MsgBox("Missing driver for connection." & vbCr & _
"Please download the following driver, install it and try again." & vbCr & vbCr & _
"Do you want to download the driver?", vbInformation + vbYesNo, "Missing Driver") = vbYes Then
Dim oInternet As Object
Set oInternet = CreateObject("INTERNETEXPLORER.APPLICATION")
oInternet.Navigate "http://dev.mysql.com/downloads/connector/odbc/"
oInternet.Visible = True
Set oInternet = Nothing
End If
Else
MsgBox Err.Description, vbInformation + vbOKOnly, "Error Connecting"
End If
Resume Exit_Handler
End Function
' Sample RecordSet
Function GetRecordSet(oConn As Object, ByVal strSQLCommand) As Object
Dim oRecordSet As Object
Dim oCmd As Object
Dim oParam As Object
On Error GoTo Error_Handler
Set oCmd = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.Recordset")
With oCmd
Set .ActiveConnection = oConn
.CommandType = 1
.CommandText = strSQLCommand
Set oRecordSet = .Execute
End With
Exit_Handler:
If oRecordSet.State = 1 Then
Set GetRecordSet = oRecordSet
Else
Set GetRecordSet = Nothing
End If
On Error GoTo 0
' Clean up
Set oRecordSet = Nothing
Set oCmd = Nothing
Set oParam = Nothing
Exit Function
Error_Handler:
MsgBox "Error in: " & ThisWorkbook.VBProject.VBE.ActiveCodePane.CodeModule & vbCr & _
Err.Description, vbCritical
Resume Exit_Handler
End Function
Function TransposeBigArray(ByVal arrValues As Variant) As Variant
Dim ret() As Variant
Dim iDim1 As Long
Dim iDim2 As Long
' Expand the array to fit all the values
' Make it base 1 to match the range values.
ReDim ret(UBound(arrValues, 2), UBound(arrValues, 1))
For iDim1 = 0 To UBound(arrValues, 1)
For iDim2 = 0 To UBound(arrValues, 2)
ret(iDim2, iDim1) = arrValues(iDim1, iDim2)
Next iDim2
Next iDim1
Exit_Handler:
TransposeBigArray = ret
Exit Function
Error_Handler:
On Error GoTo 0
Resume Exit_Handler
End Function
:) :) :)
I have a query-database question. Since this is more like and advice post I have made the questions bold.
I have a workbook that currently queries data from a database and its using procedure No1 to get the data. This gets the job don't without any problem most of the time; but sometimes when the sql takes a while to return the data Excel tends to crash.
I was think if using a ADO object combination of Connections and Recordsets will perform a little bit better. I have been using this in other macros and it's been working fine (small datasets returned).
http://msdn.microsoft.com/en-us/library/windows/desktop/ms675944%28v=vs.85%29.aspx
Will this object crash under a lot of records? I am talking about an array(200,41)
The problem with this second solution is that the headings can vary from procedure to procedure and I need the headings to identify other data.
Is there a way to create an array with the data and the headings?
Thanks a lot for your help and advice. :) :) :)
Procedure No1.
Dim oQueryTable As QueryTable
Dim strConnection As String
strConnection = "ODBC;DRIVER=SQL Server;" & _
"SERVER=myServer;" & _
"UID=myID;" & _
"PWD=myPass;" & _
"DATABASE=myDataBase"
Set oQueryTable = rDumpRange.Parent.QueryTables.Add(Connection:=strConnection, Destination:=rDumpRange)
With oQueryTable
.CommandText = QueryText
.Name = ReportName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
This is some code I have created for the ADO.
Option Explicit
Private Const m_intMYSQL As Integer = 1
Private Const m_intSQL As Integer = 2
Enum conType
conMySQL = m_intMYSQL
conSQL = m_intSQL
End Enum
Function GetConnection(eType As conType, _
ByVal strServer As String, _
ByVal strDataBase As String, _
ByVal strUser As String, _
ByVal strPassword As String) As Object
Dim oConn As Object
Dim strConn As String
On Error GoTo Error_Handler
' Instantiate the connection object
Set oConn = CreateObject("ADODB.Connection")
If eType = conMySQL Then
strConn = "Driver={MySQL ODBC 5.3 ANSI Driver};" & _
"Server=" & strServer & ";" & _
"Database=" & strDataBase & ";" & _
"User=" & strUser & ";" & _
"Password=" & strPassword & ";"
ElseIf eType = conSQL Then
strConn = "Provider=SQLOLEDB.1;" & _
"Data Source=" & strServer & ";" & _
"Initial Catalog=" & strDataBase & ";" & _
"User ID=" & strUser & ";" & _
"Password=" & strPassword & ";"
End If
' Try to open the connection.
oConn.Open strConn
Exit_Handler:
' If the connection opened succesfully return it
If oConn.State = 1 Then
Set GetConnection = oConn
Else
Set GetConnection = Nothing
End If
On Error GoTo 0
' Clean up
Set oConn = Nothing
Exit Function
Error_Handler:
' If the error is realted to the driver missing. Let the user know.
' Open internet and navigate to the code.
If Err.Number = -2147467259 Then
If MsgBox("Missing driver for connection." & vbCr & _
"Please download the following driver, install it and try again." & vbCr & vbCr & _
"Do you want to download the driver?", vbInformation + vbYesNo, "Missing Driver") = vbYes Then
Dim oInternet As Object
Set oInternet = CreateObject("INTERNETEXPLORER.APPLICATION")
oInternet.Navigate "http://dev.mysql.com/downloads/connector/odbc/"
oInternet.Visible = True
Set oInternet = Nothing
End If
Else
MsgBox Err.Description, vbInformation + vbOKOnly, "Error Connecting"
End If
Resume Exit_Handler
End Function
' Sample RecordSet
Function GetRecordSet(oConn As Object, ByVal strSQLCommand) As Object
Dim oRecordSet As Object
Dim oCmd As Object
Dim oParam As Object
On Error GoTo Error_Handler
Set oCmd = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.Recordset")
With oCmd
Set .ActiveConnection = oConn
.CommandType = 1
.CommandText = strSQLCommand
Set oRecordSet = .Execute
End With
Exit_Handler:
If oRecordSet.State = 1 Then
Set GetRecordSet = oRecordSet
Else
Set GetRecordSet = Nothing
End If
On Error GoTo 0
' Clean up
Set oRecordSet = Nothing
Set oCmd = Nothing
Set oParam = Nothing
Exit Function
Error_Handler:
MsgBox "Error in: " & ThisWorkbook.VBProject.VBE.ActiveCodePane.CodeModule & vbCr & _
Err.Description, vbCritical
Resume Exit_Handler
End Function
Function TransposeBigArray(ByVal arrValues As Variant) As Variant
Dim ret() As Variant
Dim iDim1 As Long
Dim iDim2 As Long
' Expand the array to fit all the values
' Make it base 1 to match the range values.
ReDim ret(UBound(arrValues, 2), UBound(arrValues, 1))
For iDim1 = 0 To UBound(arrValues, 1)
For iDim2 = 0 To UBound(arrValues, 2)
ret(iDim2, iDim1) = arrValues(iDim1, iDim2)
Next iDim2
Next iDim1
Exit_Handler:
TransposeBigArray = ret
Exit Function
Error_Handler:
On Error GoTo 0
Resume Exit_Handler
End Function
:) :) :)