Newsgroup: it.comp.lang.visual-basic
Titolo: [ADO ,MSFlexgrid e mdb] mi correggete pf?

Premetto che non sono un drago ma mi vorrei arrangiare per risolvermi
qualeche esigenza d'ufficio.
Ho trovato in rete questo esempio su come collegare un mdb tramite ADO
riempendo poi una msflexrid.
Ho provato a modificarlo per usarlo e sono riuscito a farlo
funzinicchiare, tranne la ricerca sull'intero db.
Nel senso che,parzializzando la ricerca (sql) con LIKE tutto è OK, se
chiedo lo sbrodolo del db, questo mi viene mostrato non
indicizzato,avete idea del perchè ?
Grazie mille
R.Zanni
----------------
Option Explicit
Dim Cnn As ADODB.Connection
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock
As Long) As Long
Private Sub Command1_Click()
Dim tmpRst As New ADODB.Recordset
Dim sSQL   As String
sSQL = "SELECT * from MC_ITA WHERE nome LIKE '%" & Trim(Text1.Text) &
"%'"
tmpRst.Open sSQL, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
Screen.MousePointer = vbHourglass
MSFlexGrid1.Clear
'***FILL THE MSFLEXGRID CONTROL***
FillGrid MSFlexGrid1, tmpRst, "Nome
|^Identifica   |^Formula                        |^Concentrazione
%|^Temp.°C|^UPVC|^PE|^PP|^PVDF|^PVCC|^NBR|^EPDM|^FPM|^PTFE"
Screen.MousePointer = vbDefault
tmpRst.Close
Set tmpRst = Nothing
End Sub
Private Sub Command2_Click()
Dim tmpRst As New ADODB.Recordset
Dim sSQL   As String
sSQL = "SELECT * from MC_ING WHERE nome LIKE '%" & Trim(Text1.Text) &
"%'"
tmpRst.Open sSQL, Cnn, adOpenKeyset, adLockOptimistic, adCmdText
Screen.MousePointer = vbHourglass
MSFlexGrid1.Clear
'***FILL THE MSFLEXGRID CONTROL***
FillGrid MSFlexGrid1, tmpRst, "^Name
^|Identify     |^Formula                        |^Concentration
%|^Temp.°C|^UPVC|^PE|^PP|^PVDF|^PVCC|^NBR|^EPDM|^FPM|^PTFE"
Screen.MousePointer = vbDefault
tmpRst.Close
Set tmpRst = Nothing
End Sub
Private Sub Form_Load()
ConnectToDb
MSFlexGrid1.Rows = 2
MSFlexGrid1.FixedRows = 1
MSFlexGrid1.FixedCols = 0
End Sub
Private Function FillGrid(Grd As MSFlexGrid, Rst As ADODB.Recordset,
FormatHeadings As String) As Integer
  On Error GoTo ErrorFillingGrid
  Dim i      As Integer
  Dim r      As Integer
  Dim c      As Integer
 
  FillGrid = 0
 
  LockWindowUpdate MSFlexGrid1.hWnd
 
  Grd.SelectionMode = 1
  Grd.HighLight = 1
  Grd.FocusRect = 0
  'Define the Headers
  If Len(FormatHeadings) > 0 Then
    Grd.FormatString = FormatHeadings
  End If
 
  i = 0
 
  With Grd
  If Rst.EOF Then
    'If the Recordset is Empty then exit funtion an return 1 like error
code
    .Rows = 1
    FillGrid = 1
  Else
    r = 1  'The starting row
    c = 0  'The starting column
    .Rows = Rst.RecordCount + 1  'The number of rows
 
 
 
    Do While Not Rst.EOF 'Loop trough the cols and rows to put the data.
      For c = 0 To .Cols - 1
        If c = c Then
            If Rst(c) = 1 Then
                MSFlexGrid1.Row = r
                MSFlexGrid1.Col = c
                MSFlexGrid1.CellBackColor = vbGreen
                MSFlexGrid1.CellForeColor = vbGreen
            End If
            If Rst(c) = 2 Then
                MSFlexGrid1.Row = r
                MSFlexGrid1.Col = c
                MSFlexGrid1.CellBackColor = vbYellow
                MSFlexGrid1.CellForeColor = vbYellow
            End If
            If Rst(c) = 3 Then
                MSFlexGrid1.Row = r
                MSFlexGrid1.Col = c
                MSFlexGrid1.CellBackColor = vbRed
                MSFlexGrid1.CellForeColor = vbRed
            End If
        End If
            .TextMatrix(r, c) = IIf(IsNull(Rst(c)), vbNullString,
Rst(c))
      Next c
      Rst.MoveNext
      r = r + 1
    Loop
  End If
  End With
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
  LockWindowUpdate False
 
  Exit Function
 
ErrorFillingGrid:
MsgBox "Error No. " & Err & " " & Err.Source & vbCrLf & Err.Description,
vbCritical, "Error FillGrid"
FillGrid = 1
Resume Next
End Function
Private Sub ConnectToDb()
Dim sCnn          As String
Dim sPath         As String
Dim sDatabaseName As String
sPath = App.Path & "\"
sDatabaseName = "ResistenzeChimiche.mdb"
sCnn = "Provider=Microsoft.Jet.OLEDB.4.0;"
sCnn = sCnn & "Data Source=" & sPath & sDatabaseName & ";"
sCnn = sCnn & "Jet OLEDB:Database Password=123;"
sCnn = sCnn & "Jet OLEDB:Engine Type=5"
Set Cnn = New ADODB.Connection
Cnn.CursorLocation = adUseClient
Cnn.CommandTimeout = 300
Cnn.Open sCnn
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cnn.Close
Set Cnn = Nothing
End Sub
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

Ho risolto grazie cmq


 "%' order by nome"
hth
-- 
Salutoni
Sergio
Per rispondere... togli il group dall'indirizzo
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it