View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Javier Ortega[_2_] Javier Ortega[_2_] is offline
external usenet poster
 
Posts: 3
Default Need HELP with QueryTable, ADO, EXCEL and EXCEL'S Formulas

I'm sorry about the code. here you a

In a Excel Formula you put in for example:

=lista("select * from table1")

Lista check and prepare de SQL and fit the optional parameters and then it
calls the other function "CreaConsulta".

When in CreaConsulta is reached the Refresh, automatically is called lista
function again.

I found a person that have the same problem, you can see the following link:

http://p2p.wrox.com/topic.asp?TOPIC_ID=669


And other thing I have probed the application.enableevents = false but it
doesn't work.

Any ideas?
Thank you.

'This is my function in Excel Formula
Public Function lista(sqlTXT As String, Optional par1 As Variant, Optional
par2 As Variant) As Variant

Dim salida, auxSalidaOK

'This check if the connection is opened or not. If it is closed, the
connection is created.
If Not conexion_abierta Then
MyConnect
End If

salida = ""

'The parameters a Par1: Destination Cell if missing is the cell under
the formula. Par2: True o False if you want headings or not.
auxSalidaOK = CreaConsulta(sqlTXT, IIf(IsMissing(par1),
Application.Caller.Offset(1, 0), par1), IIf(IsMissing(par2), True, par2))
salida = IIf(auxSalidaOK, "OK", "FALLO SQL")

lista = salida
End Function



'This is the function that creates the Query
Private Function CreaConsulta(sql As String, Celda As Range, cabecera As
Boolean) As Boolean
Dim aux As QueryTable
Dim inter As Range
Dim salida, nuevaConsulta As Boolean

salida = False

Set RS = conn.Execute(sql) 'This is a global definition

'Look for other QueryTables in order to know if it is a new one or an
old one.
If Celda.Worksheet.QueryTables.Count 0 Then
For Each aux In Celda.Worksheet.QueryTables()
'Check the range result if intersect or not with our destination.
Set inter = Application.Intersect(aux.Destination, Celda)

If inter Is Nothing Then
nuevaConsulta = True 'It is a new one
Else
nuevaConsulta = False 'It is a old one
Exit For
End If
Next aux
Else
nuevaConsulta = True 'If there is no QueryTables, is a new one.
End If

If Not nuevaConsulta Then
With Celda.QueryTable
.FieldNames = IIf(cabecera, True, False)
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = False
.PreserveColumnInfo = False
Set .Recordset = RS
salida = .Refresh(false)
If .FetchedRowOverflow Then
MsgBox "There is a lot of rows in the Query."
End If
End With
Else
With Celda.Worksheet.QueryTables.Add(RS, Celda)
.FieldNames = IIf(cabecera, True, False)
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = False
.PreserveColumnInfo = False
salida = .Refresh(False)
If .FetchedRowOverflow Then
MsgBox "There is a lot of rows in the Query."
End If
End With
End If

CreaConsulta = salida

End Function