Skapa parameterfrågor

I detta exempel demonstreras en teknik för att skapa s k parameterfrågor, dvs användarna får ange vissa villkor för utsökning av data när proceduren exekveras. Detta är möjligt genom att vi använder oss av Command-objektet.

I exemplet används ADO (ActiveX Data Objects) för import av data till Excel.

Saknas ADO-biblioteket på din dator kan den hämtas från Microsofts databashemsida. Det kan vara aktuellt för dig som använder XL 97 med ett äldre operativsystem än Windows 2000.

Innan proceduren körs måste en referens sättas till ADO:s bibliotek:
Det sker på följande sätt:

1. Öppna VB-Editorn i Excel.

2. Välj kommandot Verktyg | Referenser...

3. Kryssa för Microsoft ActiveX Data Objects x.x Library.

 

Om ett felmeddelande erhålls vid kopiering till VBA-modul så läs mer här»
 

 

(© 2002 - 2003 All rights Colo - Used by permission)

Option Explicit  

Sub Parameter_Fraga()

   '© 2003 Alla rättigheter XL-Dennis

   Dim cnt As ADODB.Connection

   Dim cmd As ADODB.Command

   Dim prm As ADODB.Parameter

   Dim rst As ADODB.Recordset

   Dim stCon As String

   Dim vaNr As Variant

 

   'Skapar och definierar anslutningen

   Set cnt = New ADODB.Connection

   stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" _

         & "Data Source=E:\Arbetsmaterial\XLData1.mdb;" _

         & "Persist Security Info=False"

   cnt.ConnectionString = stCon

   cnt.Open

 

   'Skapar och definierar kommandot.

   Set cmd = New ADODB.Command

   With cmd

      .ActiveConnection = cnt

      .CommandText = "Parameters [Artikelnr] Long;" & _

                                "SELECT * FROM tblData WHERE Nummer=[Artikelnr]"

      .CommandType = adCmdText

   End With

 

   'Skapar och definierar parametern.

   Set prm = cmd.CreateParameter("[Artikelnr]", adInteger, adParamInput)

   cmd.Parameters.Append prm

   vaNr = Trim(Application.InputBox(Prompt:="V v ange artikelnr:",  _
                      Title:="Skapa parameterfråga", Type:=1))

   'För engelsk version ersätts "Falskt" med "False".

   If vaNr = "Falskt" Then GoTo ExitHere

   prm.Value = vaNr

 

   'Öppnar recordset och kopierar den utvalda data till aktivt arbetsblad.

   Set rst = cmd.Execute

   With ActiveSheet.Cells(2, 1)

      .CurrentRegion.ClearContents

      .CopyFromRecordset rst

   End With

 

   ExitHere:

   Set rst = Nothing   

   Set prm = Nothing

   Set cmd = Nothing

   cnt.Close

   Set cnt = Nothing

End Sub