
' --------------------------------------------------------
' Hands-On 31-1
' No code.
' Please follow the instructions in the book.
' --------------------------------------------------------


' --------------------------------------------------------
' Hands-On 31-2
' No code.
' Please follow the instructions in the book.
' --------------------------------------------------------


' --------------------------------------------------------
' Hands-On 31-3
' --------------------------------------------------------

Sub GetAttachmentNames()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rstChild As DAO.Recordset2
    Dim fldAttach As DAO.Field2
    
    Dim strCustName As String
        
    Set db = CurrentDb
    Set rst = db.OpenRecordset("Customers")
    rst.MoveFirst
    
    Do Until rst.EOF
       strCustName = rst("Last Name").Value
      
      'open a recordset for the attachement field
      Set rstChild = rst!Attachments.Value
      
      Do Until rstChild.EOF
        rstChild.MoveFirst
        Set fldAttach = rstChild.Fields("FileName")
          Do Until rstChild.EOF
            Debug.Print strCustName & Chr(0) & _
                Chr(45) & Chr(0) & fldAttach.Value
           rstChild.MoveNext
          Loop
      Loop
      rst.MoveNext
    Loop
    
    rst.Close
    db.Close
    Set fldAttach = Nothing
    Set rstChild = Nothing
    Set rst = Nothing
    Set db = Nothing
End Sub


' --------------------------------------------------------
' Code on page 853
' --------------------------------------------------------

Sub FieldNamesInAttachments()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim fldMain As DAO.Field2
    Dim fldChild As DAO.Field2
    Dim fldItem As DAO.Field2
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("Customers")
    
    For Each fldMain In rst.Fields
        If fldMain.IsComplex Then
            Set fldChild = rst.Fields(fldMain.Name)
            For Each fldItem In fldChild.ComplexType.Fields
                Debug.Print fldItem.Name
            Next
        End If
    Next
    
    rst.Close
    db.Close
    Set fldItem = Nothing
    Set fldChild = Nothing
    Set fldMain = Nothing
    Set rst = Nothing
    Set db = Nothing
End Sub


' --------------------------------------------------------
' Hands-On 31-4
' --------------------------------------------------------

Sub SaveAttachmentsToDisk()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rstChild As DAO.Recordset
    Dim fldAttach As DAO.Field2
    Dim strFile As String
    
    Const dirName = "C:\CollectAttachments"
    Set db = CurrentDb
    
    ' Open the recordset for the Customers table
    Set rst = db.OpenRecordset("Customers")
    rst.MoveFirst
    
    Do Until rst.EOF
     'open a recordset for the attachement field
      Set rstChild = rst!Attachments.Value
      
      Do Until rstChild.EOF
        If Dir(dirName, vbDirectory) = "" Then MkDir dirName
        rstChild.MoveFirst
        ' get the binary data of the attachment file
        Set fldAttach = rstChild.Fields("FileData")
          Do Until rstChild.EOF
            strFile = dirName & "\" & rstChild.Fields("FileName").Value
            If Dir(strFile) = "" Then
               fldAttach.SaveToFile strFile
            End If
            rstChild.MoveNext
          Loop
      Loop
      rst.MoveNext
    Loop

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


' --------------------------------------------------------
' Hands-On 31-5
' --------------------------------------------------------

Sub AddAttachmentToRecord()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rstChild As DAO.Recordset2
    Dim addFlag As Boolean
    
    Const dirName = "C:\Acc07_HandsOn\External Docs\"
    Const fileN = "California3.jpg"
    
    Set db = CurrentDb
    
    ' Open the recordset for the Customers table
    Set rst = db.OpenRecordset("Customers")
    
    'move to the 16th customer (count records from 0)
    rst.Move 15
        
    ' initialize child recordset
    Set rstChild = rst.Fields("Attachments").Value

    If rstChild.RecordCount > 0 Then
    'check if the specified file is already attached
        Do Until rstChild.EOF
            If rstChild.Fields("FileName").Value = fileN Then
               addFlag = True
               Exit Do
            End If
        Loop
    End If
    If addFlag Then MsgBox "The specified file " & fileN & _
                " is already attached to this record."
    If Not addFlag Then
      ' put the parent recordset in Edit mode
      rst.Edit
      ' add a new record to the child recordset
      rstChild.AddNew
      ' load the attchment file
      rstChild.Fields("FileData").LoadFromFile dirName & fileN
      ' update both the child and parent recordsets
      rstChild.Update
      rst.Update
      
      MsgBox "Successfully attached " & fileN & " to " & _
                rst.Fields(1).Value & " record."
    End If
    
    rstChild.Close
    Set rstChild = Nothing
    rst.Close
    Set rst = Nothing
    Set db = Nothing
End Sub


' --------------------------------------------------------
' Hands-On 31-6
' --------------------------------------------------------

Sub RemoveAttachmentFromRecord()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rstChild As DAO.Recordset2
    Dim removeFlag As Boolean

    Const dirName = "C:\Acc07_HandsOn\External Docs\"
    Const fileN = "California3.jpg"
    
    Set db = CurrentDb

    ' Open the recordset for the Customers table
    Set rst = db.OpenRecordset("Customers")
    
    'move to the 16th customer
    rst.Move 15
      
    ' get the child recordset for the Attachments field
    Set rstChild = rst.Fields("Attachments").Value
    
    ' search for the attachment file and remove it if found
    Do Until rstChild.EOF
        If rstChild.Fields("FileName").Value = fileN Then
            rstChild.Delete
            removeFlag = True
        End If
        rstChild.MoveNext
    Loop
    ' display a message
    If Not removeFlag Then
      MsgBox "The specified file " & fileN & _
                " is not attached to this record.", _
                vbOKOnly + vbInformation, "Nothing to Remove"
    Else
         MsgBox "The specified file " & fileN & _
                " was deleted from this record.", _
                vbOKOnly + vbInformation, "Attachment Removed"
    End If
    
    ' cleanup code
    rstChild.Close
    Set rstChild = Nothing
    rst.Close
    Set rst = Nothing
    Set db = Nothing
End Sub



' --------------------------------------------------------
' Hands-On 31-7
' No Code.
' Please follow the instructions in the book.
' --------------------------------------------------------


' --------------------------------------------------------
' Hands-On 31-8
' No Code.
' Please follow the instructions in the book.
' --------------------------------------------------------


' --------------------------------------------------------
' Hands-On 31-9
' --------------------------------------------------------

Sub RetrieveMultiValues()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rstChild As DAO.Recordset2
    Dim strCustName As String
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("Customers")
    rst.MoveFirst
    
    ' open the parent recordset
    Do Until rst.EOF
        strCustName = rst![Last Name].Value
    
        ' open the child recordset
        Set rstChild = rst![Literature Sent].Value
        If rstChild.RecordCount > 0 Then Debug.Print strCustName
        Do Until rstChild.EOF
            Debug.Print Chr(0) & Chr(45) & Chr(0) _
                & rstChild!Value.Value
            rstChild.MoveNext
        Loop
        rst.MoveNext
    Loop
    
' cleanup
    rst.Close
    db.Close
    Set rstChild = Nothing
    Set rst = Nothing
    Set db = Nothing
End Sub


' --------------------------------------------------------
' Hands-On 31-10
' --------------------------------------------------------

Function AddToMultiValueList(strTblName As String, _
                            strMultiFldName As String, _
                            strNewVal As String)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field2
    Dim prp As DAO.Property

    On Error GoTo ErrorHandler
    
    Set db = CurrentDb
    Set tdf = db.TableDefs(strTblName)
    Set fld = tdf.Fields(strMultiFldName)

    If fld.Properties("RowSourceType").Value = "Value List" Then
        Set prp = fld.Properties("RowSource")
        Debug.Print prp.Value
        
        If InStr(1, prp.Value, strNewVal) = 0 Then
            prp.Value = prp.Value & Chr(59) & Chr(34) _
              & strNewVal & Chr(34)
            Debug.Print prp.Value
        End If
    End If
    
ExitHere:
    Set prp = Nothing
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
Exit Function

ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    GoTo ExitHere
End Function


' --------------------------------------------------------
' Custom Project 31-1
' --------------------------------------------------------

Sub CreateTblUserNotes()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field2
    Dim idx As DAO.Index
    
    On Error GoTo ErrorHandler
    
    Set db = CurrentDb
       
    ' create UserNotes table
    Set tdf = db.CreateTableDef("UserNotes")
    
    ' creata an AutoNumber field
    Set fld = tdf.CreateField("UID", dbLong)
    fld.Attributes = dbAutoIncrField
    tdf.Fields.Append fld
    
    ' create the Primary Key on UID field
    Set idx = tdf.CreateIndex("PrimaryKey")
    With idx
        .Primary = True
        .Fields.Append tdf.CreateField("UID")
    End With
    
    'append the index
    tdf.Indexes.Append idx
           
    ' create a text field
    Set fld = tdf.CreateField("UserName", dbText, 50)
    tdf.Fields.Append fld
    
    ' create a memo field
    Set fld = tdf.CreateField("ProblemDescription", dbMemo)
    tdf.Fields.Append fld
    
    ' set the memo field to track version history
    fld.AppendOnly = True
    
    ' append table to the database
    db.TableDefs.Append tdf
    
    Application.RefreshDatabaseWindow
    
ExitHere:
    ' cleanup
    Set idx = Nothing
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
Exit Sub

ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume ExitHere
End Sub


Sub RetrieveMemoHistory()
    Dim arrayString() As String
    Dim MemoText As String
    Dim i As Integer
    Dim strSearch As String
    Dim startPos As Integer
    Dim EndDatePos As Integer
    Dim EndTimePos As Integer
    Dim MemoDate As Date
    Dim MemoTime As Date
    
    arrayString = Split(Application.ColumnHistory("UserNotes", _
                "ProblemDescription", "UID=1"), "[Version:  ")
    If UBound(arrayString) = -1 Then
        MsgBox "There is no history data for this field."
        Exit Sub
    End If
    
    For i = 1 To UBound(arrayString)
        startPos = 1
        strSearch = arrayString(i)
        EndDatePos = InStr(startPos, strSearch, " ")
        MemoDate = CDate(Left(strSearch, EndDatePos - 1))
            
        startPos = EndDatePos + 1
        EndTimePos = InStr(startPos, arrayString(i), "]") - 3
        MemoTime = CDate(Mid(strSearch, startPos, EndTimePos - startPos))
        
        startPos = EndTimePos + 3
        strSearch = Trim(Replace(strSearch, vbCrLf, ""))
        MemoText = Right(strSearch, Len(strSearch) - startPos)
        Debug.Print MemoDate, MemoTime, MemoText
    Next
End Sub


' --------------------------------------------------------
' Custom Project 31-2
' --------------------------------------------------------

Private Sub Attachments_AttachmentCurrent()
    If Me.DefaultView = 0 Then
        If Me.Attachments.AttachmentCount = 0 Then
            Me.txtCurrentFileName.Visible = False
        Else
            Me.txtCurrentFileName.Visible = True
        End If
        Me.txtNumOfFiles = Me.Attachments.AttachmentCount
        Me.txtCurrentFileName = Me.Attachments.FileName
    End If
End Sub


' --------------------------------------------------------
' Hands-On 31-11
' --------------------------------------------------------

Private Sub Detail_Paint()
    If Me.City.Value = "Chicago" Then
        Me.City.ForeColor = vbBlue
    Else
        Me.City.ForeColor = vbBlack
    End If
End Sub

