Ciao a tutti, sto cercandi di fare una piccola agenda con ADO e una Database access...
Sono riuscito a fare tutto, tranne la funzione di ricerca dove sto riscontrando molti problemi...
C'è qualcuno che mi potrebbe dare una mano a fare queta funzione di ricerca?...Magari acnhe postandomi un esempio...
Grazie mille, ciao a tutti...
P:S Metto il codice se potesse servire:
Option Explicit
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
'Listview
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim ItemCount As Integer
Dim WinDir As String
Private Sub Command1_Click()
If Text1.Text = "" Then
MsgBox "Inserisci un nome valido", vbCritical, "Nome"
Text1.SetFocus
Exit Sub
End If
rs.AddNew
rs.Fields("Nome") = Text2.Text
rs.Fields("Cognome") = Text1.Text
rs.Fields("Indirizzo") = Text3.Text
rs.Fields("Comune") = Text4.Text
rs.Fields("Provincia") = Text5.Text
rs.Fields("Codice") = Text6.Text
rs.Fields("Telefono") = Text7.Text
rs.Fields("Fax") = Text8.Text
rs.Fields("Mail") = Text9.Text
rs.Fields("Note") = Text10.Text
rs.Fields("Path1") = txtPath1.Text
rs.Fields("Path2") = txtPath2.Text
rs.Fields("Path3") = txtPath3.Text
rs.Update
End Sub
Private Sub Command12_Click()
Dir1.Visible = True
End Sub
Private Sub Command13_Click()
Dir3.Visible = True
End Sub
Private Sub Command14_Click()
Dir2.Visible = True
End Sub
Private Sub Command2_Click()
If Not (rs.BOF = True Or rs.EOF = True) Then
If MsgBox("Sei sicuro di voler cancellare questo record?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete?") = vbYes Then
rs.Delete
txtPath1.Text = "C:\"
txtPath2.Text = "C:\"
txtPath3.Text = "C:\"
rs.MoveNext
If rs.EOF Then
rs.MovePrevious
End If
FillFields
End If
Else
MsgBox "Nessun record esistente! ", vbExclamation, "No Record"
End If
End Sub
Private Sub Command3_Click()
If Not (rs.BOF = True And rs.EOF = True) Then
rs.MovePrevious
If Not rs.BOF Then
FillFields
Else
rs.MoveFirst
MsgBox "Primo record raggiunto", vbExclamation
End If
Else
MsgBox "Nessun record esistente", vbExclamation
End If
End Sub
Private Sub Command4_Click()
If Not (rs.BOF = True And rs.EOF = True) Then
rs.MoveNext
If Not rs.EOF Then
FillFields
Else
rs.MoveLast
MsgBox "Ultimo record raggiunto", vbExclamation
End If
Else
MsgBox "Nessun record esistente", vbExclamation
End If
End Sub
Private Sub Command5_Click()
rs.Fields("Nome") = Text2.Text
rs.Fields("Cognome") = Text1.Text
rs.Fields("Indirizzo") = Text3.Text
rs.Update
End Sub
Private Sub Command7_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
End Sub
Private Sub Command8_Click()
If Not (rs.BOF = True And rs.EOF = True) Then
rs.MoveFirst
If Not rs.BOF Then
FillFields
Else
rs.MoveFirst
MsgBox "Primo record raggiunto", vbExclamation
End If
End If
End Sub
Private Sub Command9_Click()
If Not (rs.BOF = True And rs.EOF = True) Then
rs.MoveFirst
If Not rs.BOF Then
FillFields
Else
rs.MoveFirst
MsgBox "Primo record raggiunto", vbExclamation
End If
End If
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
Dim buf As String * 256
Dim return_len As Long
Dim wid1 As Single
return_len = GetWindowsDirectory(buf, Len(buf))
WinDir = Left$(buf, return_len) & "\"
LoadDesktop
txtPath1.Text = Dir1.Path
End Sub
Private Sub Dir2_Change()
File2.Path = Dir2.Path
Dim buf As String * 256
Dim return_len As Long
Dim wid1 As Single
return_len = GetWindowsDirectory(buf, Len(buf))
WinDir = Left$(buf, return_len) & "\"
LoadDesktop1
txtPath2.Text = Dir2.Path
End Sub
Private Sub Dir3_Change()
File3.Path = Dir3.Path
Dim buf As String * 256
Dim return_len As Long
Dim wid1 As Single
return_len = GetWindowsDirectory(buf, Len(buf))
WinDir = Left$(buf, return_len) & "\"
LoadDesktop2
txtPath3.Text = Dir3.Path
End Sub
Private Sub Form_Click()
Dir1.Visible = False
Dir2.Visible = False
Dir3.Visible = False
End Sub
Private Sub Form_Load()
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\Database.mdb"
cn.Open
Set rs = New ADODB.Recordset
With rs
.Open "Clienti", cn, adOpenKeyset, adLockPessimistic, adCmdTable
Do While Not .EOF
rs.MoveNext
Loop
If Not (.EOF And .BOF) Then
rs.MoveFirst
FillFields
End If
End With
'Listview
Dim buf As String * 256
Dim return_len As Long
Dim wid1 As Single
return_len = GetWindowsDirectory(buf, Len(buf))
WinDir = Left$(buf, return_len) & "\"
LoadDesktop
LoadDesktop1
LoadDesktop2
Dim p As Integer
p = 0
End Sub
Private Sub LoadDesktop()
ListView1.ListItems.Clear
ListView1.View = 2
Dim imgX As ListImage
Dim FileName As String
Dim Spot As Integer
Dim SpotB As Integer
Dim x As Integer
File1.Path = Dir1.Path
For x = 0 To Dir1.ListCount - 1 '-------LOAD FOLDERS
DoEvents
ItemCount = ItemCount + 1
FileName = Dir1.List(x)
DisplayIcons (FileName)
Set imgX = IMGSmall.ListImages.Add(ItemCount, , PixSmall.Picture)
Set imgX = IMGLarge.ListImages.Add(ItemCount, , pixLarge.Picture)
ListView1.Icons = IMGLarge
ListView1.SmallIcons = IMGSmall
Spot = 1
Do Until Spot = 0
SpotB = Spot
Spot = InStr(SpotB + 1, FileName, "\")
DoEvents
Loop
'SpotB = Spot
Dim ItemX As ListItem
Set ItemX = ListView1.ListItems.Add()
ItemX.Text = Right$(FileName, Len(FileName) - SpotB)
ItemX.Icon = ItemCount
ItemX.SmallIcon = ItemCount
ItemX.Tag = ItemCount
Next x
For x = 0 To File1.ListCount - 1 '-------LOAD FILES
DoEvents
ItemCount = ItemCount + 1
FileName = Dir1.Path & "\" & File1.List(x)
DisplayIcons (FileName)
Set imgX = IMGSmall.ListImages.Add(ItemCount, , PixSmall.Picture)
Set imgX = IMGLarge.ListImages.Add(ItemCount, , pixLarge.Picture)
ListView1.Icons = IMGLarge
ListView1.SmallIcons = IMGSmall
Spot = 1
Do Until Spot = 0
SpotB = Spot
Spot = InStr(SpotB + 1, FileName, "\")
DoEvents
Loop
'SpotB = Spot
Set ItemX = ListView1.ListItems.Add()
ItemX.Text = Right$(FileName, Len(FileName) - SpotB)
ItemX.Icon = ItemCount
ItemX.SmallIcon = ItemCount
ItemX.Tag = ItemCount
Next x
Visible = True
End Sub
Function DisplayIcons(Fname As String) As Long
Dim hImgSmall As Long
Dim hImgLarge As Long
Dim info1 As String
Dim info2 As String
On Local Error GoTo cmdLoadErrorHandler
hImgSmall = SHGetFileInfo(Fname$, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
info1 = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
info2 = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
PixSmall.Picture = LoadPicture()
PixSmall.AutoRedraw = True
ImageList_Draw hImgSmall&, shinfo.iIcon, PixSmall.hDC, 0, 0, ILD_TRANSPARENT
PixSmall.Picture = PixSmall.Image
hImgLarge = SHGetFileInfo(Fname, 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
info1 = Left$(shinfo.szDisplayName, InStr(shinfo.szDisplayName, Chr$(0)) - 1)
info2 = Left$(shinfo.szTypeName, InStr(shinfo.szTypeName, Chr$(0)) - 1)
pixLarge.Picture = LoadPicture()
pixLarge.AutoRedraw = True
ImageList_Draw hImgLarge&, shinfo.iIcon, pixLarge.hDC, 0, 0, ILD_TRANSPARENT
pixLarge.Picture = pixLarge.Image
Exit Function
cmdLoadErrorHandler:
pixLarge.Picture = LoadPicture()
End Function
Public Sub FillFields()
If Not (rs.BOF = True Or rs.EOF = True) Then
Text1.Text = rs.Fields("Cognome")
Text2.Text = rs.Fields("Nome")
Text3.Text = rs.Fields("Indirizzo")
Text4.Text = rs.Fields("Comune")
Text5.Text = rs.Fields("Provincia")
Text6.Text = rs.Fields("Codice")
Text7.Text = rs.Fields("Telefono")
Text8.Text = rs.Fields("Fax")
Text9.Text = rs.Fields("Mail")
Text10.Text = rs.Fields("Note")
txtPath1.Text = rs.Fields("Path1")
txtPath2.Text = rs.Fields("Path2")
txtPath3.Text = rs.Fields("Path3")
Else
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
txtPath1.Text = ""
txtPath2.Text = ""
txtPath3.Text = ""
End If
End Sub
Rispondi quotando
