
'----------------------------------------------------------------
' Hands-On 14-1
'----------------------------------------------------------------

Sub AddNewRec_DAO()
    Dim db As DAO.Database
    Dim tblRst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set tblRst = db.OpenRecordset("Employees")
    
    With tblRst
        .AddNew
        .Fields("Company") = "Northwind Traders"
        .Fields("Last Name") = "Smith"
        .Fields("First Name") = "Regina"
        .Fields("Job Title") = "Marketing Director"
        .Fields("E-mail Address") = "regina@northwindtraders.com"
        .Update
    End With
      
    tblRst.Close
    Set tblRst = Nothing
    db.Close
    Set db = Nothing
End Sub

'----------------------------------------------------------------
' Hands-On 14-2
'----------------------------------------------------------------

' Use the References dialog box
' to set up a reference to
' the Microsoft ActiveX Data 2.8 Object Library

Sub AddNewRec_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   Set rst = New ADODB.Recordset
   With rst
      .Open "SELECT * FROM Employees", _
         strConn, adOpenKeyset, adLockOptimistic

      ' Add a record and specify some field values
      .AddNew
      ![Company] = "Northwind Traders"
      ![Last Name] = "Roberts"
      ![First Name] = "Paul"
      ![Job Title] = "Sales Representative"
      ![E-mail Address] = "paul@northwindtraders.com"

      ' Retrieve the Employee ID for the current record
      Debug.Print !ID.Value

      ' Move to the first record
      .MoveFirst
      Debug.Print !ID.Value
      .Close
   End With

   Set rst = Nothing
   Set conn = Nothing
End Sub

'----------------------------------------------------------------
' Hands-On 14-3
'----------------------------------------------------------------

Sub ModifyRecord_DAO()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strFind As String
    Dim intResult As Integer
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set rst = db.OpenRecordset("Employees", dbOpenTable)
    
    rst.MoveFirst
    ' change the Zip/Postal Code of all employees from 99999 to 99998
    
    Do While Not rst.EOF
        With rst
            .Edit
            .Fields("Zip/Postal Code") = "99998"
            .Update
            .MoveNext
        End With
    Loop
    
    ' find the record for Regina Smith - enter data in Country/Region field
    strFind = "Smith"
    rst.MoveFirst
    rst.Index = "Last Name"
    
    rst.Seek "=", strFind
    MsgBox rst![Last Name]
    Debug.Print rst.EditMode
    rst.Edit
    
    rst![Country/Region] = "USA"
    If rst.EditMode = dbEditInProgress Then
        intResult = MsgBox("Do you want to save the changes " & _
            "to this record?", vbYesNo, _
            "Save or Cancel Changes?")
    End If
    If intResult = 6 Then 'Save changes
       rst.Update
    ElseIf intResult = 7 Then 'Cancel changes
       rst.CancelUpdate
    End If
    
    'rst.Update
    rst.Close

    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-4
'----------------------------------------------------------------

Sub ModifyRecord_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   Set rst = New ADODB.Recordset

   With rst
      .Open "SELECT * FROM Employees Where [Last Name] = 'Roberts'", _
         strConn, adOpenKeyset, adLockOptimistic
      .Fields("City").Value = "Redmond"
      .Fields("State/Province") = "WA"
      .Fields("Country/Region").Value = "USA"
      .Update
      .Close
   End With
   
   Set rst = Nothing
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-5
'----------------------------------------------------------------

Sub BatchUpdate_Records_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String
   Dim strCriteria As String

   strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   strCriteria = "[Job Title] = 'Sales Representative'"

   Set conn = New ADODB.Connection
   conn.Open strConn

   Set rst = New ADODB.Recordset

   With rst
      Set .ActiveConnection = conn
      .Source = "Employees"
      .CursorLocation = adUseClient
      .LockType = adLockBatchOptimistic
      .CursorType = adOpenKeyset
      .Open
      .Find strCriteria
      Do While Not .EOF
         .Fields("Job Title") = "Sales Rep"
         .Find strCriteria, 1
      Loop
      .UpdateBatch
   End With

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-6
'----------------------------------------------------------------

Sub DeleteRecord_DAO()
    Dim db As DAO.Database
    Dim tblRst As DAO.Recordset
    Dim counter As Integer
   
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    
    ' delete all the employees with ID greater than 9
    Set tblRst = db.OpenRecordset("Employees")
    tblRst.MoveFirst
    Do While Not tblRst.EOF
        Debug.Print tblRst!ID
        If tblRst![ID] > 9 Then
            tblRst.Delete
            counter = counter + 1
        End If
        tblRst.MoveNext
    Loop
    
    MsgBox "Number of deleted records: " & counter
    tblRst.Close
    Set tblRst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-7
'----------------------------------------------------------------

Sub Delete_Record_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String
   Dim strCriteria As String

   'call procedure from Hands-On 14-2 to ensure
   'that we have a record to delete
   AddNewRec_ADO
   
   strConn = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   Set conn = New ADODB.Connection
   Set rst = New ADODB.Recordset

   With rst
      .Open "SELECT * FROM Employees Where [Last Name] ='Roberts'", _
          strConn, adOpenKeyset, adLockOptimistic
      .Delete
      .Close
   End With
   Set rst = Nothing
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-8
'----------------------------------------------------------------

Sub ExportToExcel_DAO()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim xlApp As Object
    Dim wkb As Object
    Dim rng As Object
    Dim strExcelFile As String
    Dim strDB As String
    Dim strTable As String
    Dim count As Integer
    Dim iCol As Integer
    Dim rowsToReturn As Integer
    
    strDB = "C:\Acc07_ByExample\Northwind 2007.accdb"
    strTable = "Employees"
    strExcelFile = CurrentProject.Path & "\ExcelFromAccess.xls"
       
    'If excel file already exists delete it
    If Dir(strExcelFile) <> "" Then Kill strExcelFile
    
    Set db = OpenDatabase(strDB)
    Set rst = db.OpenRecordset(strTable)
    
    'get the number of records from the recordset
    count = rst.RecordCount
        
    rowsToReturn = CInt(InputBox("How many records to copy?"))
    If rowsToReturn <= count Then
       
        'set the reference to Excel and make Excel visible
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Application.Visible = True
        
        'set references to the Excel workbook and worksheet
        Set wkb = xlApp.Workbooks.Add
        Set objSheet = xlApp.ActiveWorkbook.sheets(1)
        objSheet.Activate
        
        'write column names to the first worksheet row
        For iCol = 0 To rst.Fields.count - 1
         objSheet.Cells(1, iCol + 1).Value = rst.Fields(iCol).Name
        Next
    
        'specify the cell range that will receive the data
        Set rng = objSheet.Cells(2, 1)
        
        'copy the specified number of records to the worksheet
        rng.CopyFromRecordset rst, rowsToReturn
        
        'autofit the columns to make the data fit
        objSheet.columns.AutoFit
        
        'close the workbook
        'and save it in Excel 97-2003 file format
        wkb.SaveAs FileName:=strExcelFile, FileFormat:=56
        wkb.Close
        
        'quit Excel and release object variables
        Set objSheet = Nothing
        Set wkb = Nothing
        xlApp.Quit
        Set xlApp = Nothing
    Else
        MsgBox "Please specify a number less than " & count + 1 & "."
    End If
    
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-9
'----------------------------------------------------------------


' be sure to select Microsoft Word 12 Object Library
' in the References dialog box

Public myWord As Word.Application  ' this declaration must be placed at the top of the module

Sub SendToWord_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim doc As Word.Document
   Dim strSQL As String
   Dim varRst As Variant
   Dim f As Variant
   Dim strHead As String

   Set conn = New ADODB.Connection
   Set rst = New ADODB.Recordset

   conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   strSQL = "SELECT [Order ID] as OrderID,"
   strSQL = strSQL & "[Ship Name], "
   strSQL = strSQL & "[Ship City] FROM [Invoice Data]"

   conn.Open
   rst.Open strSQL, conn, adOpenForwardOnly, _
      adLockReadOnly, adCmdText

   ' retrieve data and table headings into variables
   If Not rst.EOF Then
      varRst = rst.GetString(adClipString, , vbTab, vbCrLf)
      For Each f In rst.Fields
         strHead = strHead & f.Name & vbTab
      Next
   End If

   ' notice that Word application is declared
   ' at the top of the module
   Set myWord = New Word.Application

   ' create a new Word document
   Set doc = myWord.Documents.Add
   myWord.Visible = True

   ' paste contents of variables into
   ' Word document
   doc.Paragraphs(1).Range.Text = strHead & vbCrLf
   doc.Paragraphs(2).Range.Text = varRst

   On Error GoTo ErrorHandler
   doc.Close SaveChanges:=wdPromptToSaveChanges
EndProc:
   myWord.Quit
   Set myWord = Nothing
   Exit Sub
ErrorHandler:
   If Err = 4198 Then MsgBox "You refused to save this document."
   Resume EndProc
End Sub


'----------------------------------------------------------------
' Hands-On 14-10
'----------------------------------------------------------------

Sub SendToWord2()
   Dim db As DAO.Database
   Dim doc As Word.Document
   Dim WordTbl As Word.Table
   Dim f As Variant
   Dim numRows As Integer
   Dim numFields As Integer
   Dim r As Integer           ' row counter
   Dim c As Integer           ' column counter

   Set db = OpenDatabase("C:\Acc07_ByExample\Northwind.mdb")
   Set rst = db.OpenRecordset("Shippers")

   numRows = rst.RecordCount
   numFields = rst.Fields.count

   ' notice that the Word application is declared
   ' in the module where you entered the procedure
   ' from Hands-On 14-9
   
   Set myWord = New Word.Application

   ' create a new Word document
   Set doc = myWord.Documents.Add

   ' insert table
   Set WordTbl = doc.Tables.Add _
      (doc.Range, numRows + 1, numFields)

   c = 1
   If numRows > 0 Then
      ' Create the column headings in table cells
      For Each f In rst.Fields
         With WordTbl
            .Cell(1, c).Range.Text = f.Name
            c = c + 1
         End With
      Next f
   End If

   r = 2
   Do While Not rst.EOF
      For c = 1 To numFields
         WordTbl.Cell(r, c).Range.Text = rst.Fields(c - 1).Value
      Next c
      r = r + 1
      rst.MoveNext
   Loop

   myWord.Visible = True

   rst.Close
   Set rst = Nothing
   Set myWord = Nothing
   db.Close
   Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-11
'----------------------------------------------------------------

Sub WriteToFile()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim f As ADODB.Field
   Dim fso As Object
   Dim txtfile As Object
   Dim strFileName As String

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   strFileName = CurrentProject.Path & "\TestFile.txt"
   
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set txtfile = fso.CreateTextFile(strFileName, True)

   Set rst = New ADODB.Recordset
   rst.Open "[Order Details]", conn
   With rst
      For Each f In .Fields
         ' Write field name to the text file
         txtfile.Write (f.Name)
         txtfile.Write Chr(9)
      Next
      ' move to a new line
      txtfile.WriteLine
      ' write out all the records to the text file
      txtfile.Write rst.GetString(adClipString)
      .Close
   End With

   txtfile.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-12
'----------------------------------------------------------------

Sub FilterWithSQLWhere_DAO()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim qryName As String
    Dim mySQL As String
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
        
    qryName = "qryOrdersOver100"
    mySQL = "SELECT * FROM " _
    & "[Product Orders] WHERE Quantity > 100;"
    Set qdf = db.CreateQueryDef(qryName)
    qdf.SQL = mySQL
    Set rst = db.OpenRecordset(qryName)
    Debug.Print "There are " & rst.RecordCount & _
    " orders with the order quantity greater than 100."
    
    rst.Close
    Set rst = Nothing
    Set qdf = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-13
'----------------------------------------------------------------

Sub FilterWithSQLWhere_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strSQL As String

   strSQL = "SELECT * FROM Employees Where IsNull(Region)" & _
      " OR TitleOfCourtesy = 'Mrs.' "

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   rst.Open strSQL, conn, adOpenKeyset, adLockOptimistic
   MsgBox "Selected " & rst.RecordCount & " records."

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-14
'----------------------------------------------------------------

Sub FilterRecords_DAO()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim FilterRst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set rst = db.OpenRecordset("Employees", dbOpenDynaset)
    rst.Filter = "City like 'R*'"
    Set FilterRst = rst.OpenRecordset()
    
    Do Until FilterRst.EOF
        Debug.Print FilterRst.Fields("Last Name").Value
        FilterRst.MoveNext
    Loop
      
    FilterRst.Close
    Set FilterRst = Nothing
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-15
'----------------------------------------------------------------

Sub FilterRecords_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   With rst
      .Open "Customers", conn, adOpenKeyset, adLockOptimistic
      .Filter = "City='Madrid' and Country='Spain'"
      MsgBox .RecordCount & " records meet the criteria.", _
          vbInformation, "Customers in Madrid (Spain)"
   End With

   Do Until rst.EOF
      Debug.Print rst.Fields(1).Value
      rst.MoveNext
   Loop

   rst.Filter = adFilterNone
   MsgBox "Filter was removed. " & vbCr _
      & "The table contains " & rst.RecordCount & " records."

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 14-16
'----------------------------------------------------------------

Sub SortRecords_ADO()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset

   ' sort on non-indexed field
   With rst
      .CursorLocation = adUseClient
      .Open "Customers", conn, adOpenKeyset, adLockOptimistic
      .Sort = "Country"
      Do Until rst.EOF
         Debug.Print rst.Fields("CompanyName").Value & ": " & _
             rst.Fields("Country").Value
         .MoveNext
      Loop
      Debug.Print "------------original sort"
      .Sort = ""
      Do Until .EOF
         Debug.Print rst.Fields("CompanyName").Value & ": " & _
             rst.Fields("Country").Value
         .MoveNext
      Loop
      .Close
   End With

   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


