ACCESS更新処理 (ｴﾗｰｺｰﾄﾞ3113, ﾌｨｰﾙﾄﾞが更新可能ではありません)

Question

質問の仕方が間違っていたらすみません。

作成中のACCESS VBAがあるのですが登録・更新処理で、新規登録は問題なく動きますが更新登録ができません。

色々調べた結果、JOIN結合しているところ、ｴﾗｰ内容と同じように更新可能のﾌｨｰﾙﾄﾞ辺りに問題があると思うのですが・・・

下画面が画面推移になります。(データシートはサブフォームで取得しています。)

更新したい行のデータをダブルクリックで下画面に行き、登録ボタンを押すとパラメータの入力表示が出ます。

パラメータの入力でOKボタンを押すと

【ｴﾗｰｺｰﾄﾞ,3113,ﾌｨｰﾙﾄﾞ' BUSHO_CD 'は更新できません。ﾌｨｰﾙﾄﾞが更新可能ではありません。】

と出て更新登録できません。

解決方法として何が考えられるでしょうか？

お出しする情報が少ないとは思いますがご教示お願いします。

VBA内の関係しそうな処理の一部を下記に記します。

標準モジュール内のユーザー定義型テーブル

'■スタッフマスタ　　　　　　　　　　　　　　　　　　　

Public Type MSTTBL_STAFF　　　　　　　　　　　　　

    STAFF_CD                      As String    ' スタッフコード　　　

    STAFF_NAME                    As String    ' スタッフ名　　　　

    BUSHO_CD                      As String    ' 部署コード　　　 

    PASSWORD                      As String    ' パスワード

End Type

'■部署マスタ　

Public Type MSTTBL_BUSHO

　BUSHO_CD                      As String    ' 部署コード

　BUSHO_NAME                    As String    ' 部署名

End Type

Form_frm_staff_sign内の処理****一部

'//////////////////////////////////////////////////////////

' 保存値セット

'//////////////////////////////////////////////////////////

Private Sub SetEntryData(ByRef i_entry_data As MSTTBL_STAFF)

On Error GoTo Err_Proc

    Dim key_val             As Long

    ' データ項目設定

    i_entry_data.STAFF_CD = Nz(Me.txt_STAFF_CD, "")

    i_entry_data.STAFF_NAME = Nz(Me.txt_STAFF_NAME, "")

    i_entry_data.BUSHO_CD = Nz(Me.cmb_BUSHO_CD, "")

    i_entry_data.PASSWORD = Nz(Me.txt_PASSWORD, "")

Exit_Proc:

   Exit Sub

Err_Proc:

    MsgBox Err.Description

    MsgBox Err.Number

    Resume Exit_Proc

End Sub                                                              

'//////////////////////////////////////////////////////////

' データ取得

'//////////////////////////////////////////////////////////

Private Function GetData(ByVal i_staff_cd As String) As Boolean

On Error GoTo Err_Proc

    Dim strSQL      As String

    Dim rs          As Recordset

    '=========================================

    ' データ抽出

    '=========================================

    'SQL文字列生成

    strSQL = "SELECT"

    strSQL = strSQL & "         a.STAFF_CD,"

    strSQL = strSQL & "         a.STAFF_NAME,"

    strSQL = strSQL & "         a.BUSHO_CD,"

    strSQL = strSQL & "         b.BUSHO_NAME,"

    strSQL = strSQL & "         a.PASSWORD"

    strSQL = strSQL & "    FROM MSTTBL_STAFF AS a"

    strSQL = strSQL & "         LEFT JOIN MSTTBL_BUSHO AS b ON"

    strSQL = strSQL & "         a.BUSHO_CD = b.BUSHO_CD"

    strSQL = strSQL & "   WHERE STAFF_CD = '" & i_staff_cd & "'"

    'データ取得

    Set rs = CurrentDb.OpenRecordset(strSQL)

    '値取得

    If Not rs Is Nothing Then

        If (rs.RecordCount = 0) Then

            GetData = False

            Exit Function

        End If

    Else

        GetData = False

        Exit Function

    End If

    '==========================================

    ' 画面表示

    '==========================================

    ' 基本情報

    Me.txt_STAFF_CD = Nz(rs("STAFF_CD"), "")

    Me.txt_STAFF_NAME = Nz(rs("STAFF_NAME"), "")

    Me.cmb_BUSHO_CD = Nz(rs("BUSHO_CD"), "")

    Me.txt_BUSHO_NAME = Nz(rs("BUSHO_NAME"), "")

    Me.txt_PASSWORD = Nz(rs("PASSWORD"), "")

   '戻りセット

   GetData = True

Exit_Proc:

   'オブジェクト破棄

   If Not rs Is Nothing Then

        Set rs = Nothing

   End If

    Exit Function

Err_Proc:

    MsgBox Err.Description

    MsgBox Err.Number

    '戻りセット

    GetData = False

    Resume Exit_Proc

'////////////////////////////////////////////////////////////////////////////

' データ更新処理

'////////////////////////////////////////////////////////////////////////////

Private Function UpdateData(ByVal i_staff_cd As String) As Boolean                             

On Error GoTo Err_Proc

    Dim type_STAFF                                   As MSTTBL_STAFF

    Dim strSQL                                       As String

    '===============================================

    ' 保存値セット

    '===============================================

    Call SetEntryData(type_STAFF)

    '===============================================

    ' SQL生成

    '===============================================

    strSQL = "UPDATE MSTTBL_STAFF"

    strSQL = strSQL & " SET    STAFF_CD          = '" & type_STAFF.STAFF_CD & "',"

    strSQL = strSQL & "        STAFF_NAME       = '" & type_STAFF.STAFF_NAME & "',"

    strSQL = strSQL & "        BUSHO_CD　       = '" & type_STAFF.BUSHO_CD & "',"

    strSQL = strSQL & "        PASSWORD          = '" & type_STAFF.PASSWORD & "'"

    strSQL = strSQL & "  WHERE STAFF_CD = '" & i_staff_cd & "'"

    '================================================

    'SQL実行セクション

    '================================================

    'SQL実行

    DoCmd.RunSQL strSQL

    '戻り値セット

    UpdateData = True

Exit_Proc:

    Exit Function

Err_Proc:

    MsgBox (Err.Number & ", " & Err.Description)

    UpdateData = False

    Resume Exit_Proc

End Function

Answer 1

> 更新したい行のデータをダブルクリックで下画面に行き、

> 登録ボタンを押すとパラメータの入力表示が出ます。

> パラメータの入力でOKボタンを押すと

> 【ｴﾗｰｺｰﾄﾞ,3113,ﾌｨｰﾙﾄﾞ' BUSHO_CD 'は更新できません。ﾌｨｰﾙﾄﾞが更新可能ではありません。】

> と出て更新登録できません。

>     strSQL = "UPDATE MSTTBL_STAFF"

>     strSQL = strSQL & " SET    STAFF_CD          = '" & type_STAFF.STAFF_CD & "',"

>     strSQL = strSQL & "        STAFF_NAME       = '" & type_STAFF.STAFF_NAME & "',"

>     strSQL = strSQL & "        BUSHO_CD　       = '" & type_STAFF.BUSHO_CD & "',"

>     strSQL = strSQL & "        PASSWORD          = '" & type_STAFF.PASSWORD & "'"

>     strSQL = strSQL & "  WHERE STAFF_CD = '" & i_staff_cd & "'"

"BUSHO_CD" の右の1文字が全角スペースになっているからでしょう。

Answer 2

おかげで解決できました。

こんなミスで時間を取られていたなんて・・・

助かりました。ありがとうございます。