Reply To: Access Database

[Support 1a]

Another example:

Dim iDlg


HRT = Chr(13) & Chr(10) 
DB_NAME = Utilities.GetDataDirectory & "Test.mdb"
const CAPTION = "Formativ Business Solutions"

'-------------------------------------------------------------------------------
' Mainline processing
'-------------------------------------------------------------------------------
Sub Main(Client, GWEvent)
  
  dim FSO         
  Dim iADOObj   
  
  on error resume next
  set FSO = CreateObject("Scripting.FileSystemObject")  
      
  ' Do we have the database in place?
  if FSO.FileExists(DB_NAME) then
    
    ' create a new instance of an ADO Connection object 
    Set iADOObj = CreateObject("ADODB.Connection")  
    if isobject(iADOObj) then
    
      ' open the test data source with the Connection object  
      iConnnectString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DB_NAME  
      iADOObj.Open iConnnectString
      
      ' Are we connected?
      if err.number = 0 then
        
        ' Dialog
        IntroDlg
        select case iDlg.execute
          case Btn1 AddNewRecord(iADOObj)
          case Btn3 DisplayAllRecords(iADOObj)    
          case Btn4 FindRecord(iADOObj)
          case Btn5 EditRecord(iADOObj) 
        end select
      else
        call msgbox(err.description, vbCritical, CAPTION)
      end if
      
      ' Close and remove the Connection object from memory
      iADOObj.Close
    else
      call msgbox("Failed to create ADODB.Connection object.", vbCritical, CAPTION)
    end if   
  
    Set iADOObj = Nothing 
  else
    call msgbox (DB_NAME & " - not found.", vbCritical, CAPTION)
  end if
  
  set FSO = nothing
                  
End Sub


'-------------------------------------------------------------------------------
' Find and display a record in the database (e.g James).
'-------------------------------------------------------------------------------
Sub FindRecord(byref iADOObj)

  dim iRST
  
  iRecordFound = FALSE
  
  ' create a Recordset object from a SQL string  
  iSQLString = "SELECT * FROM Employee WHERE Name='" &   InputBox("Enter the name you want to find")  & "'"
  Set iRST = iADOObj.Execute(iSQLString)
 

  Do Until (iRST.EOF)
    call msgbox("Name: " & iRST("Name") & HRT & "ID: " & iRST("ID"), vbInformation, CAPTION)
    iRST.MoveNext
    iRecordFound = TRUE
  Loop
  
  if not iRecordFound then
    call msgbox("No records found.", vbInformation, CAPTION)    
  end if

  ' close and remove the Recordset object from memory  
  iRST.Close
  Set iRST = Nothing  
end sub


'-------------------------------------------------------------------------------
' Display all records in the database
'-------------------------------------------------------------------------------
Sub DisplayAllRecords(byref iADOObj)
  
  dim iRST
  
  ' create a Recordset object from a SQL string  
  iSQLString = "SELECT * FROM Employee"  
  Set iRST = iADOObj.Execute(iSQLString)
 
  ' retrieve all the data within the Recordset object  
  call msgbox("Displaying all records ...", vbInformation, CAPTION)

  Do Until (iRST.EOF)
    call msgbox("Name: " & iRST("Name") & HRT & "ID: " & iRST("ID"), vbInformation, CAPTION)
    iRST.MoveNext
  Loop

  call msgbox("End of data.", vbInformation, CAPTION)

  ' close and remove the Recordset object from memory  
  iRST.Close
  Set iRST = Nothing
  
end sub



'-------------------------------------------------------------------------------
' Add a new record into database
'-------------------------------------------------------------------------------
Sub AddNewRecord(byref iADOObj)
  
  dim rs
  
  Set rs = CreateObject("ADODB.Recordset") ' Declare variable to hold the _Recordset Object reference.

  ' Open Table1 in the database.
  Call rs.Open("Employee", iADOObj, 2, 3)

  ' Add new record in the Table1.
  Call rs.AddNew
  rs("ID") = InputBox("Enter ID") 
  rs("Name") = InputBox("Enter Name") 
  Call rs.Update
  
  call msgbox("Record added.", vbInformation, CAPTION)
  
  set rs = nothing
   
end sub


'-------------------------------------------------------------------------------
' Store existing records in a list box
'-------------------------------------------------------------------------------
sub StoreExistingRecordsDialog(byref iADOObj, byref iUpdateDlg, byref iListBox)
  dim iRST
  
  set iUpdateDlg = Utilities.NewControlBoxDialog
  with iUpdateDlg
	  .Caption = CAPTION
	  .Title = "Exsiting records"
    .Description = HRT & "Select an existing record to update"
  end with
  
  set iListBox = iUpdateDlg.AddListBoxControl  
  iListBox.Caption = "Records:"
      
  iSQLString = "SELECT * FROM Employee"  
  Set iRST = iADOObj.Execute(iSQLString)
 
  Do Until (iRST.EOF)
    iListBox.items.add(iRST("Name"))
    iRST.MoveNext
  Loop
   
  iRST.Close
  Set iRST = Nothing
    
end sub

'-------------------------------------------------------------------------------
' New records details dialog
'-------------------------------------------------------------------------------
sub UpdateExistingRecordDialog(byref iADOObj, aExtName)

  set iDlg = Utilities.NewControlBoxDialog
  with iDlg
	  .Caption = CAPTION
	  .Title = "Update record"
    .Description = HRT & "Existing record: " & aExtName
  end with
  
  set iNewName = iDlg.AddEditControl 
  iNewName.Caption = "Enter new name:"
  
  set iNewID = iDlg.AddEditControl 
  iNewID.Caption = "Enter new ID:"
  
  ' If we press the Ol button to update
  if (iDlg.execute = Btn1) then 
    if (iNewID.Text <> "") and (iNewName.Text <> "") then
      iSQLUpdate = "UPDATE Employee SET ID ='" & iNewID.Text & "', Name = '" & iNewName.Text & "'  WHERE Name ='" & aExtName & "'"
      Set iRST = iADOObj.Execute(iSQLUpdate)
      call msgbox ("record updated.", vbInformation, CAPTION)
    else
      call msgbox("Empty fields not accepted.", vbInformation, CAPTION)
      call UpdateExistingRecordDialog(iADOObj, aExtName)
    end if
  end if
  
end sub


'-------------------------------------------------------------------------------
' Edit record
'-------------------------------------------------------------------------------
sub EditRecord(byref iADOObj)
  
  dim iUpdateDlg
  dim iListBox
  
  cExit = 999
  cEditRecord = 201
  cDisplayAllRecords = 101
  Cmd = cDisplayAllRecords
  
  call StoreExistingRecordsDialog(iADOObj, iUpdateDlg, iListBox)
  
  do while Cmd <> cExit
    
    if Cmd = cDisplayAllRecords then
      select case iUpdateDlg.execute
        case Btn1 Cmd = cEditRecord
        case else Cmd = cExit
      end select
    end if
    
    if Cmd = cEditRecord then
      if iListBox.Selected <> "" then
        call UpdateExistingRecordDialog(iADOObj, iListBox.Selected)
        Cmd = cExit
      else
        call msgbox ("Select a record to update.", vbInformation, CAPTION)
        Cmd = cDisplayAllRecords
      end if
    end if
    
  loop
    
end sub


'-------------------------------------------------------------------------------
' Intro Dialog
'-------------------------------------------------------------------------------
Function IntroDlg

  set iDlg = Utilities.NewControlBoxDialog
  with iDlg
	  .Caption = CAPTION
    .Height = 250
	  .Title = "Database Management"
	  .Button1Caption = "&Add"	
	  .Button3Visible = True
	  .Button3Caption = "&Display All"	    
	  .Button4Visible = True    
	  .Button4Caption = "&Find Record"	
    .Button5Visible = TRUE
    .Button5Caption = "&Update"   
	  .Description = HRT & "This applet will allow you to add a new record, display " &_
    "all records or find a record in the database." & HRT & HRT &_
    "Database: " & DB_NAME
  end with

End Function