dotNETportal.cz

Zdravím pánové

Předem informuji, že celý projekt je psán v VB.net2010, proto píši zde.

Chtěl bych se zeptat, zda by někdo poradil jak zjistit z dotazu, názvy a datové typy parametrů ? Potřeboval bych znát parametry ještě před průchodem recordsetu, protože jinak logicky dojde k chybě ?

Celý by to mělo pracovat tak, že si aplikace načte seznam dotazů uložených v access, vytvoří z toho položky v menu, vytvoří se událost na zpracování dotazu a výsledek je následně uložen do clipboardu. Pokud však dotaz obsahuje parametry, tak vyžadované informace bude muset zadat uživatel přímo v aplikaci, ještě dříve než bude dotaz poslám pro zpracování v recordsetu.

Dotaz s parametrem si vytvořit umím, ostatně je toho plný net, ale obrácený postup, kde z již existujicího dotazu potřebuji nejdříve zjistit parametry, tak o tom jsem nic nenašel.

Řešit bych to sice mohl vytvářením dotazů přímo v aplikaci, ale to bych poté musel aktualizovat a kompilovat aplikaci po každém požadavku na aktualizaci či přidání dotazu.

Posílám kód, který funguje přesně jak má ale jen u bezparametrických dotazů. Posílám jen část, která se týká zpracování samotného dotazu.

Kdyby by někdo poradil, byl bych moc vděčný.

Imports Microsoft.Office.Interop
Public Class c_ImportQuery
    Public Sub QueryToClipboard(ByVal QueryName As String)
        Dim CS As String = Global.MS.My.MySettings.Default.MSConnectionString
        Dim adoCon As New ADODB.Connection With {.ConnectionString = CS}
        Dim adoRec As New ADODB.Recordset

        Dim TheString As New System.Text.StringBuilder
        Clipboard.Clear()
        TheString.Append("")
        Try
            Application.DoEvents()
            f_MDI.Cursor = Cursors.WaitCursor
            adoCon.Open()
            adoRec.Open(QueryName, adoCon, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockPessimistic)
            With adoRec
                For Each adoField As ADODB.Field In .Fields
                    TheString.Append(adoField.Name & " " & adoField.Type & vbTab)
                Next
                TheString.Remove(TheString.Length - 1, 1)
                TheString.Append(vbCr)
                Do Until .EOF
                    For Each adoField As ADODB.Field In .Fields
                        TheString.Append(adoField.Value & vbTab)
                    Next
                    .MoveNext()
                    TheString.Remove(TheString.Length - 1, 1)
                    TheString.Append(vbCr)
                Loop
            End With
            Clipboard.SetDataObject(TheString.ToString)
            cMessage.StatusText("Projekce byla úspěšně vytvořena", False)
        Catch ex As Exception
            cMessage.ErrorMsg(Err.Description, "Chyba Projekce")
        Finally
            Try
                adoRec.Close()
                adoCon.Close()
                adoRec = Nothing
                adoCon = Nothing
            Catch ex As Exception
            Finally
                f_MDI.Cursor = Cursors.Default
            End Try
        End Try
    End Sub
End Class

Tak už jsem to formou pokus omyl vyřešil. Hlavní zádrhel byl v tom, že adodb.command nenačítá parametry bez předchozího refresh. Koho by to napadlo ? Zjistil jsem to tak, že mi kód fungoval jen když jsem si kód v ladícím prostředí na příslušném řádku zastavil a rozklikl seznam argumentů. Tím se "nějak" zinicializoval a pak fungoval, v opačném případě vždy hodil chybnou hlášku.

Kdyby se to někomu hodilo tak zasílám celý kód níže. Je tam pár volání mimo třídu, ale to už si může každý sám pořešit.

Imports Microsoft.Office.Interop
Public Class c_ImportQuery
    Public Sub QueryList()
        Dim oAccess As New Access.Application()
        With oAccess
            Try
                Application.DoEvents()
                f_MDI.Cursor = Cursors.WaitCursor
                .OpenCurrentDatabase(dbSource, False)
                For Each Query As Access.AccessObject In oAccess.Application.CurrentData.AllQueries
                    Dim NewMenu As New ToolStripMenuItem()
                    With NewMenu
                        .Name = Query._Name
                        .Text = Query._Name
                        AddHandler NewMenu.Click, AddressOf Me.MenuClick
                        f_MDI.Menu_Dotazy.DropDownItems.Add(NewMenu)
                    End With
                Next
            Catch ex As Exception
                cMessage.ErrorMsg(Err.Description, "Chyba QueryList")
            Finally
                oAccess = Nothing
                f_MDI.Cursor = Cursors.Default
            End Try
        End With
    End Sub
    Private Sub MenuClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Call QueryToClipboard(sender.name)
    End Sub
    Public Sub QueryToClipboard(ByVal QueryName As String)
        Dim CS As String = Global.MS.My.MySettings.Default.MSConnectionString
        Dim adoCon As New ADODB.Connection With {.ConnectionString = CS}
        adoCon.Open()
        Dim adoCat As New ADOX.Catalog With {.ActiveConnection = adoCon}
        Dim adoCmd As New ADODB.Command
        Dim IsParameter As Boolean = False
        adoCmd.Parameters.Refresh()
        Try
            Try
                adoCmd = adoCat.Procedures(QueryName).Command
                For Each adoPrm As ADODB.Parameter In adoCmd.Parameters
                    IsParameter = True
                    Select Case adoPrm.Type
                        Case ADODB.DataTypeEnum.adDate
                            d_InputBoxDate.CallMe(adoPrm.Name.ToString)
                            adoPrm.Value = ibDate
                    End Select
                Next
            Catch ex As Exception
                adoCmd = adoCat.Views(QueryName).Command
            End Try

        Catch ex As Exception
            cMessage.ErrorMsg(Err.Description, "Chyba při dekleraci parametrů dotazu")
        End Try

        Dim adoRec As New ADODB.Recordset
        Dim TheString As New System.Text.StringBuilder
        Clipboard.Clear()
        TheString.Append("")
        Try
            Application.DoEvents()
            f_MDI.Cursor = Cursors.WaitCursor
            If IsParameter Then
                adoRec.Open(adoCmd, , ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly, ADODB.CommandTypeEnum.adCmdStoredProc)
            Else
                adoRec.Open(adoCmd, , ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)
            End If

            With adoRec
                For Each adoField As ADODB.Field In .Fields
                    TheString.Append(adoField.Name & vbTab)
                Next
                TheString.Remove(TheString.Length - 1, 1)
                TheString.Append(vbCr)
                Do Until .EOF
                    For Each adoField As ADODB.Field In .Fields
                        TheString.Append(adoField.Value & vbTab)
                    Next
                    .MoveNext()
                    TheString.Remove(TheString.Length - 1, 1)
                    TheString.Append(vbCr)
                Loop
            End With
            Clipboard.SetDataObject(TheString.ToString)
            cMessage.StatusText("Schránka byla úspěšně naplněna", False)
        Catch ex As Exception
            cMessage.ErrorMsg(Err.Description, "Chyba při vyhodnocení dotazu")
        Finally
            Try
                adoRec.Close()
                adoRec = Nothing
                adoCmd.Cancel()
                adoCmd = Nothing
                adoCat = Nothing
                adoCon.Close()
                adoCon = Nothing
            Catch ex As Exception
            Finally
                f_MDI.Cursor = Cursors.Default
            End Try
        End Try
    End Sub
    End Class

Ještě dotaz. Při průchodu seznamů dotazů (v kódu: Public Sub QueryList), mi msAccess zůstane viset v paměti dokud celá aplikace neskončí. Jenže pokud je konktrétní DB MsAccess v paměti, tak jí v době běhu programu nelze běžně uživatelsky otevřít. Existuje nějaký způsob jak jí shodit okamžitě ?

Nepomáhají ani standartní metody:

.CloseCurrentDatabase()

.Quit()

oAccess = Nothing