So-net無料ブログ作成

アクセス小僧:履歴を残す(3) [コンピューター]

アクセス小僧:履歴を残す(2)
https://cheese999.blog.so-net.ne.jp/2018-10-05
で、フォーム上に展開したテーブル(テーブルA)のうち、フォーム上で参照したレコードのID(主キー)の履歴を別テーブル(テーブルB)に残して、後で戻るためのマクロを紹介しました。

しかし、後で戻るためのマクロの下記コード部分が、うまく動かない場合があることが分かりました。

With Me.Recordset
  .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴].Value
  ' Debug.Print ".NoMatch=" & .NoMatch
  If .NoMatch Then
    Ans = MsgBox("PW_Mng_ID = " & [PW_Mng_ID履歴].Value & "が見つかりません。", vbCritical, "エラー")
  End If
End With

フォーム上に展開したテーブル(テーブルA)のレコードをMe.Recordsetとして、その中でID(主キー)検索をかけるのは正しい方法では無いのかもしれません。

別のやり方として、テーブル(テーブルA)を別のRecordsetとして開き、その中でID検索を行ってレコード番号を入手、フォーム上でレコード番号を元に移動するマクロに変更しました。

加えて、履歴のコンボボックスの値([PW_Mng_ID履歴].Value)ではなく、履歴のコンボボックスのListIndex([PW_Mng_ID履歴].ListIndex)を参照することで、コンボボックスに表示する値をID番号だけではなく、項目名とか、氏名とか、人間が見て分かりやすい内容にすることができます。

【選択した履歴のレコードへ飛ぶためのマクロ(新)】

Private Sub PW_Mng_ID履歴Go_Click()
  '【変数】
  Dim Ans1 As Long ' 答え
  Dim PW_Mng_IDt As Long ' 履歴上のID
  Dim AbsPos1 As Long 'レコード番号
  Dim Str1 As String ' 文字列
  '【実行コード】
  ' ID履歴のコンボボックス(テーブルBを展開したもの)の選択肢が選択されていなければ終了
  If [PW_Mng_ID履歴].ListIndex = -1 Then
    Ans1 = MsgBox("PW_Mng_ID履歴が選択されていません。", vbCritical, "エラー")
    Exit Sub
  End If
  ' テーブルBの主キー「T_PM_ID」は、1, 2 - なので、コンボボックスのListIndexに1を足す
  Str1 = "T_PM_ID = " & CStr([PW_Mng_ID履歴].ListIndex + 1)
  ' テーブルBを検索して、テーブルAの主キーを得る
  PW_Mng_IDt = DLookup("PW_Mng_ID1", "T_PWMngID", Str1)
  Debug.Print "[PW_Mng_ID履歴].ListIndex=" & [PW_Mng_ID履歴].ListIndex & " PW_Mng_IDt=" & PW_Mng_IDt
  ' テーブルAをレコードセットとして開き、ID検索、レコード番号(AbsolutePosition)を得る
  AbsPos1 = IDtoAbsPos1("T_パスワード管理", "PW_Mng_ID", PW_Mng_IDt)
  ' レコードが見つかったら、フォーム上で、そのレコードに移動する
  If AbsPos1 <> -1 Then
    [チェック_ID履歴] = True
    DoCmd.GoToRecord acDataForm, "パスワード入力", acGoTo, AbsPos1 + 1
    [チェック_ID履歴] = False
  End If
End Sub

【テーブルAをレコードセットとして開き、IDを検索、レコード番号を返す関数(新)】

Function IDtoAbsPos1(NmTable1 As String, NmField1 As String, ID1 As Long) As Long
  '【機能】指定されたIDをテーブルで検索、見つかったらレコード番号を返す
  '【引数】
  ' NmTable1 : テーブル名
  ' NmField1 : フィールド名
  ' ID1 : 主キー
  '【返り値】
  ' レコード番号(返すレコード番号が無いときは、-1)
  '【変数】
  Dim db1 As DAO.Database ' データベース
  Dim rs1 As DAO.Recordset ' レコードセット
  Dim AbsPos1 As Long 'レコード番号
  Dim Ans1 As Long ' 答え
  '【実行コード】
  ' テーブルをレコードセットとして開く
  Set db1 = CurrentDb()
  Set rs1 = db1.OpenRecordset(NmTable1, dbOpenDynaset)
  rs1.MoveFirst ' 先頭レコードへ
  rs1.MoveLast ' 最終レコードへ
  rs1.MoveFirst ' 先頭レコードへ
  rs1.FindFirst NmField1 & " = " & ID1
  If rs1.NoMatch Then
    Ans1 = MsgBox(NmField1 & " = " & ID1 & "がありません。", vbCritical, "エラー")
    Set rs1 = Nothing
    Set db1 = Nothing
    IDtoAbsPos1 = -1
    Exit Function
  End If
  AbsPos1 = rs1.AbsolutePosition
  Set rs1 = Nothing
  Set db1 = Nothing
  IDtoAbsPos1 = AbsPos1
End Function

【選択した履歴のレコードへ飛ぶためのマクロ(旧)】

Private Sub PW_Mng_ID履歴Go_Click()
  ' Debug.Print [PW_Mng_ID履歴]
  [チェック_ID履歴] = True
  With Me.Recordset
    .FindFirst "PW_Mng_ID = " & [PW_Mng_ID履歴]
  End With
  [チェック_ID履歴] = False
End Sub

この変更を行った後、新規レコードをフォームから追加しようとしたところ、次のエラーが発生しました。

MA_error.jpg

ネットで調べたけど、原因不明。。。[猫]
ヤバイぜ!(20)  コメント(2) 
共通テーマ:パソコン・インターネット

ヤバイぜ! 20

コメント 2

cheese999

ヤバイぜ! ありがとうございます(^_0)ノ
by cheese999 (2018-11-02 06:54) 

cheese999

コンボボックスの値ではなく、ListIndexを参照するやり方に変更した説明を追記しました。
by cheese999 (2018-11-05 08:06) 

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字(英大文字の「オー」、英小文字の「ユー」、アラビア数字の「ハチ」、アラビア数字の「イチ」、アラビア数字の「ニ」)を入力してください。

Facebook コメント