Databasesøgning via regneark

Mit meget simple SQL-udtryk:

SELECT `00Apparat`.ApparatBetegnelse
FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`
WHERE (`00Apparat`.ApparatBetegnelse='George')

Er der slet ingen, der vil "byde" på den ?

Ja det kan sagtens lade sig gøre, hvis du optager selve din datahentning som en makro. Herefter kan du gå ind og editere din SQL så din WHERE betingelse bliver opdateret med værdien fra A1.

Du er velkommen til at sende arket på ck@officekonsulenterne.dk så skal jeg hjælpe dig med det!

/Christian

Hej

Her mit lille eksempel:

Sub George()
'
' George Makro
' Makro indspillet 17-02-2007
'

'
    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DBQ=C:\Temp\TempSpecialeLogbog.mdb;DefaultDir=C:\Temp;Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;Max" _
        ), Array( _
        "BufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("B1"))
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='George')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .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

Tak for venligheden


Thomas

"SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _

Når jeg afvikler scriptet som kabbak har været venlig at skrive får jeg en "Debug Error" ?

Her er et eksempel fr hjælpen, prøv at se om du kan bruge det, jeg har sat Celle A1 ind som en tekstkriterie, se om du kan rette den til.

This example runs a query on the Northwind database. The result of the query, displayed on Sheet1, is a list of all products that are currently on order.


databaseName = "NorthWind"
queryString = _
    "SELECT * FROM product.dbf WHERE (product.ON_ORDER<>'" & [A1] & "')"
chan = SQLOpen("DSN=" & databaseName)
SQLExecQuery chan, queryString
Set output = Worksheets("Sheet1").Range("A1")
SQLRetrieve chan, output, , , True
SQLClose chan

Vi er enige om, at jeg indtaster mit søgekriterie (input) i celle A1, at SQL-udtrykket afvikles under hensyntagen til mit søgekriterie og så returnerer "svar" i samme regneark f.eks i kolonne B ?

Det er bare ikke det jeg får, så jeg gør nok noget forkert

OK

Jeg har tilrettet mit oprindelige script med "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" som det foreslås og det fungerer:

    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DBQ=C:\Temp\TempSpecialeLogbog.mdb;DefaultDir=C:\Temp;Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;Max" _
        ), Array( _
        "BufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("B1"))
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .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
End Sub

Nu vil jeg så bare gerne tvinge scriptet til, altid at sende output til kolonne B

Hvor kommer det nu ??

"ActiveSheet.QueryTables.Add" betyder at du tilføjer en ny forespørgsel, den har det med at skuppe kolonner, så vidt jeg husker.

Du kan opdatere eksisterende ved at bruge denne, men om det er det du skal bruge, ved jeg ikke og om den genlæser A1, ved opdateringen.


Public Sub opdater()
For Each qt In ActiveSheet.QueryTables
    qt.Refresh
Next

End Sub

Den udskriver i kolonne B, men når jeg ændrer søgekriterie resultat af den gamle søgning mod højre

Altså det kommer i kolonne B men de gamle resultater flyttes mod højre og det ønsker jeg ikke.

Jeg ønsker kolonne B opdateret og de gamle resultater skal så blot overskrevet.

Ok, det var også det jeg skrev, hvis du brugte din makro hvergang.
Hvad sker der hvis du bruger makroen opdater i stedet, læser den den nye kriterier i A1 ind ??

Mit script ser sådan ud nu:

Sub Valg1()
'
' George Makro
' Makro indspillet 17-02-2007 af Kristina og Thomas Hansen
'

'
  With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DBQ=C:\Temp\TempSpecialeLogbog.mdb;DefaultDir=C:\Temp;Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;Max" _
        ), Array( _
        "BufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("A3"))
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .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

      'M End With
     
      For Each qt In ActiveSheet.QueryTables
      qt.Refresh
      Next
      End With
  End Sub

Jeg er ikke helt sikker på, at jeg har indsat opdateringsscriptet korrekt, men den flytter stadig blot kolonnerne til højre.

det er fordi du Adder en ny query, hvergang du kører makroe.:
kør denne 1 gang

Sub Valg1()
'
' George Makro
' Makro indspillet 17-02-2007 af Kristina og Thomas Hansen
'

'
  With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DBQ=C:\Temp\TempSpecialeLogbog.mdb;DefaultDir=C:\Temp;Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;Max" _
        ), Array( _
        "BufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("A3"))
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .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

      'M End With
   
      For Each qt In ActiveSheet.QueryTables
      qt.Refresh
      Next
      End With
  End Sub


Prøv så at køre denne ved opdatering,resten af tiden:

Sub Valg2()
'
' George Makro
' Makro indspillet 17-02-2007 af Kristina og Thomas Hansen
'

'
  With ActiveSheet.QueryTables("Forespørgsel fra TempSpecialeLogbog")
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .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
  End Sub

Når jeg kører Sub Valg2() får jeg Run-time error '9' i 1. linie

har du kørt valg1 først ?

Ja jeg kalder valg1 (der virker og dernæst kalder jeg valg2, men i 1. ste linie går det galt

prøv at ændre
With ActiveSheet.QueryTables("Forespørgsel fra TempSpecialeLogbog")
til

With ActiveSheet.QueryTables

Så får jeg Run-time error '438' i 1. linie

Jeg vil ikke garentere om det virker, da jeg kun en enkelt gang, har arbejdet med at hente data fra access via kode.

hvad sker der, hvis du kører denne kode alene.

Public Sub opdater()
For Each qt In ActiveSheet.QueryTables
    qt.Refresh
Next

Jeg kan godt afvikle scriptet, men der er jo ikke noget output

Mit sidste bud, nu kun 1 makro, i starten sletter den den gamle queryTable.
Sub Valg1()
'
' George Makro
' Makro indspillet 17-02-2007 af Kristina og Thomas Hansen
'
For Each qt In ActiveSheet.QueryTables
      qt.Delete
    Next
   
     
  With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DBQ=C:\Temp\TempSpecialeLogbog.mdb;DefaultDir=C:\Temp;Driver={Driver do Microsoft Access (*.mdb)};DriverId=25;FIL=MS Access;Max" _
        ), Array( _
        "BufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("A3"))
        .CommandText = Array( _
        "SELECT `00Apparat`.ApparatBetegnelse" & Chr(13) & "" & Chr(10) & "FROM `C:\Temp\TempSpecialeLogbog`.`00Apparat` `00Apparat`" & Chr(13) & "" & Chr(10) & "WHERE (`00Apparat`.ApparatBetegnelse='" & [A1] & "')" _
        )
        .Name = "Forespørgsel fra TempSpecialeLogbog"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCell
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False

      'M End With
    End With
   
  End Sub

Ja så kommer der kun output i kolonne A.

Jeg kan dog se, at output ikke opdateres selvom jeg fjerner mit søgekriterie.
F.eks hvis jeg fjerner søgekriteriet "George" og  lader celle A1 være tom, så returneres stadig "George" som output.

OK jeg stopper for i aften foreløbigt tak for hjælpen.

Jeg synes du skal lægge et svar - så kan jeg evt. oprette et nyt spørgsmål hvis det bliver nødvendigt. Tak for hjælpen.

Hvis det ikke virker, skal jeg heller ikke have point, svar selv og tag point tilbage.

du kan jo bruge dem i et nyt spørgsmål.
;-))

Er du stadig frisk kabbak ?

Jeg synes jo stadig du skal have de point´s for jeg er kommet noget videre ved din hjælp.

Hvis du kan hjælpe med det her vil jeg selvfølgelig også være glad: http://www.eksperten.dk/spm/764441

Jeg skal kun have point, hvis det hjalp dig.