' *********************************************************
' 修正・新規更新
' *********************************************************
Private Sub btn更新_Click()
    
    Dim TargetMDB, Query
    
' -------------------------------------------------
' 更新用フィールドチェック
' -------------------------------------------------
    If IsNull(Me.txt番号.Value) Then
        MsgBox ("番号は必須入力です")
        Me.txt番号.SetFocus
        Exit Sub
    End If
    
' -------------------------------------------------
' マスタの該当コードの存在チェック
' -------------------------------------------------
    If IsEmpty(objCn) Then
        Set objCn = CreateObject("ADODB.Connection")
    End If
    If IsEmpty(objRs) Then
        Set objRs = CreateObject("ADODB.Recordset")
    End If
    TargetMDB = Application.CurrentDb.TableDefs("T_マスタ").Connect
    TargetMDB = Replace(TargetMDB, ";DATABASE=", "")
    
    Call MDB_DBConnect(objCn, TargetMDB)
    Query = "select * from T_マスタ where コード = " & Me.txt番号.Value
    If DBGet(objCn, objRs, Query, True) Then
        MsgBox ("既に " & Me.txt番号.Value & " は存在します")
        Call DBClose(objRs)
        Call DBClose(objCn)
        Me.txt番号.SetFocus
        Exit Sub
    End If
    
    Dim strKey1, strKey2
    
    If MsgBox("更新しますか?", vbOKCancel Or vbDefaultButton2 Or vbQuestion) = vbOK Then
        
' -------------------------------------------------
' 新規用事前処理 @@ 要変更
' -------------------------------------------------
        If cmb処理モード = 1 Then
            strKey1 = Me.cmbコード.Value
            Me.cmbコード.ControlSource = "受付番号"
            Me.cmbコード.Value = strKey1
        End If
        
' -------------------------------------------------
' マスタの新規登録
' -------------------------------------------------
        Dim i
        
        objRs.AddNew
        For i = 0 To objRs.Fields.Count - 1
            objRs.Fields(i).Value = Me.Recordset.Fields(i).Value
        Next
        objRs.Fields("コードﾞ").Value = Me.txt番号.Value
        objRs.Fields("区分").Value = Me.cmb区分.Value
        objRs.Fields("クラス").Value = Me.cmbクラス.Value
        objRs.Fields("携帯電話番号").Value = Me.txt携帯電話番号.Value
        objRs.Fields("更新区分").Value = Empty
        objRs.Fields("更新日付").Value = Date
        objRs.Update
        
' -------------------------------------------------
' 元テーブルのみの更新用編集
' -------------------------------------------------
        Me.更新日付.Value = Date
        
' -------------------------------------------------
' 更新実行
' -------------------------------------------------
        bUpdate = True
        On Error Resume Next
        DoCmd.RunCommand acCmdSaveRecord
        If Err.Number <> 0 Then
            MsgBox (Err.Description)
        End If
        On Error GoTo 0
        
        
' -------------------------------------------------
' 新規用後処理
' -------------------------------------------------
        If Me.cmbコード.ControlSource <> "" Then
            Me.cmbコード.ControlSource = ""
        End If

' -----------------------------------------------------
' 現在のキーでリセット
' -----------------------------------------------------
        cmbコード_AfterUpdate
    
    End If

    Call DBClose(objRs)
    Call DBClose(objCn)

End Sub

Const adLockReadOnly = 1
Const adLockOptimistic = 3

' ******************************************************
' DB接続(MDB)
' ******************************************************
Function MDB_DBConnect( _
    Connection, _
    File _
)

    Dim ConnectionString

    ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & File & ";"

    Connection.Open ConnectionString

End Function

' ******************************************************
' DB読込み
' 【戻り値】: True(データ有り),False(データ無し)
' ******************************************************
Function DBGet( _
    Connection, _
    Record, _
    SqlQuery, _
    bUpadateFlg _
)
    
    ' 閉じていない時は閉じる
    If Record.State >= 1 Then
        Record.Close
    End If
    
    ' 更新処理に使用する場合は、レコード単位の共有的ロック
    If bUpadateFlg Then
        Record.LockType = adLockOptimistic
    Else
        Record.LockType = adLockReadOnly
    End If
    
    ' レコードセット作成
    Record.Open SqlQuery, Connection
    If Record.EOF Then
        DBGet = False
    Else
        DBGet = True
    End If

End Function

' ******************************************************
' DB終了処理(接続を閉じる)
' ******************************************************
Function DBClose( _
    CnRs _
)
    
    On Error Resume Next
    If CnRs.State >= 1 Then
        CnRs.Close
    End If

    DBClose = True

End Function