Public Sub b3_udl_accdb登録更PL()
    Dim myTblName  As String
    Dim myKey      As String
    Dim mySht      As Worksheet
    Dim i          As Long
    Dim j          As Long
    
 Call a05_InODBC
 
    myTblName = "PL" '書き込み先テーブル
    '準備ここまで
    Set mySht = Worksheets("sheet3") '書き込みデータのワークシート
    With rs
        'インデックスの設定
        .Index = "primarykey"
        'レコードセットを開く
        rs.Open Source:=myTblName, ActiveConnection:=cn, _
            CursorType:=adOpenKeyset, LockType:=adLockOptimistic, _
            Options:=adCmdTableDirect
On Error GoTo 警告

For ii = 1 To 1
Select Case ii
Case 1
        For i = 2 To mySht.Range("d50").End(xlUp).Row
            '番号が登録されているか検索する
            myKey = mySht.Cells(i, 2).Value
            '行2,列2=b2以下をキーとする
            If Not .EOF Then .Seek myKey
            If .EOF Then
               .AddNew
                For j = 1 To .Fields.Count
                    '行1,列2=「b1」からフィールド照合開始
                    .Fields(mySht.Cells(1, j + 1).Value).Value = _
                    mySht.Cells(i, j + 1).Value
                    '行2,列2=「b2」から登録開始
                Next j
                .Update
            Else
                For j = 2 To .Fields.Count
                    rs(j - 1).Value = mySht.Cells(i, j + 1).Value
                    'レコード1を   行2,列2=「b2」から更新開始
                Next
                .Update
            End If
        Next i
        MsgBox Chr(13) & "総数" & i - 2

End Select
Next

On Error GoTo 0
    End With
    
  Call a09_OutODBC 'オブジェクトの解放   
Exit Sub

警告: MsgBox "登録できません " & Chr(13) & i - 1 & " 行目"
      
  Call a09_OutODBC 'オブジェクトの解放
End Sub