日誌を１日に複数回書けるようにする

光市のＦＥ社のAccessの改修。
テーブル：D_日誌の
　　　¤ プライマリーキーはオートナンバー型にしているが、
　　　¤ ［日誌日］＋［クラスCD］を固有キーにしている。
すなわち、クラス別に１日１回（１レコード）しか書けない。更新（文章の追加）はできるのだが‥‥
１日クラス別に複数回書ける（レコードを追加できる）ようにする。

フィールドの追加

テーブル：D_日誌
1. 子ID：整数型
  - フィールド追加後、既存データには“1”を入れる。
  - その後、入力必須とし、4．項を行う。
2. 項目1：テキスト型
3. 項目2：テキスト型
4. インデックス/固有キー
  1. 日誌日
  2. クラスCD
  3. 子ID ‥‥ 追加（これがポイントだった）

改修のポイント

F_Main6
- ［追加］をクリックした時、子IDを1アップし、追加する。
- サブフォームのsfm詳細をクリックした時、該当する子IDのsfm日誌を表示する。
  - サブフォームからメインのSubをCallしている。
    　メインのSubは、Publicにしておくこと。
    　　　Call Screen.ActiveForm.F_changeSubID(Me.txt子ID)
［追加］をクリックした時のイベントプロシージャ
　DLookUp を３回行うことになるので、ADO で対応した。

Private Sub cmd追加_Click()
On Error GoTo Err_cmd追加_Click:
Dim mbTitle As String
Dim CNN As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim SQLCmd As String, strDate As String, RSTCmd As String
Dim lngClassCD As Long, koID As Long

    mbTitle = MYObjName & "/cmd追加_Click"
    VARAns = Me.txt日誌日
    If IsDate(VARAns) Then
        strDate = "#" & Format(VARAns, "yyyy/mm/dd") & "#"
    Else
        MsgBox "日付を入力してください。", vbExclamation, mbTitle
        Me.txt日誌日.SetFocus
        Exit Sub
    End If
    VARAns = Me.txtClassCD
    If IsNull(VARAns) Then
        MsgBox "クラスを指定してください。", vbExclamation, mbTitle
        Me.lstClass.SetFocus
        Exit Sub
    Else
        lngClassCD = CLng(VARAns)
    End If
    strDate = "#" & Format(Me.txt日誌日, "yyyy/mm/dd") & "#"
    STRAns = "[日誌日]=" & strDate & " and [クラスCD]=" & lngClassCD
    koID = Nz(DMax("子ID", "D_日誌", STRAns), 0)
    koID = koID + 1
        'クラス，曜日CD，レベルCD をｾｯﾄする。
    Set CNN = CurrentProject.Connection
    RSTCmd = "SELECT クラス, 曜日CD, レベルCD from T_クラス" _
            & " Where ([クラスCD]=" & lngClassCD & ")"
    RST.Open RSTCmd, CNN, adOpenForwardOnly
    DoCmd.SetWarnings False
    SQLCmd = "INSERT into D_日誌 (日誌日,クラスCD,子ID,クラス,曜日CD,レベルCD)" _
            & " SELECT " & strDate & "," & lngClassCD & "," & koID _
            & ",'" & RST!クラス & "'," & RST!曜日CD & "," & RST!レベルCD
    DoCmd.RunSQL SQLCmd
    DoEvents
    
    Me.txt子ID = koID
    Me.txt子ID.Requery
    DoEvents
            
        '[更新]状態にする。
    Me.grpMode = 2
    Call grpMode_AfterUpdate
    Me.sfm詳細.Form.Requery
    With Me.sfm日誌
        If IsNull(Me.cbo作成者) Then
            Me.cbo作成者.SetFocus
        Else
            .SetFocus
            .Form.txt作成者.SetFocus
        End If
    End With
    RST.Close: CNN.Close
    
Exit_cmd追加_Click:
    Set CNN = Nothing
    DoCmd.SetWarnings True
    Exit Sub
    
Err_cmd追加_Click:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_cmd追加_Click
End Sub