VBAを使用して、1つのレコードに複数のフィールドを追加すると同時に、各フィールドにカテゴリを追加します

debugcn 投稿 Dev

ブライアンレオ

この質問に対する答えは他の場所では見つかりませんでした。私は新しいVBAユーザーです。

植物標本のデータを入力するための非常に簡単なフォームがあります。ドロップダウンボックスがあるフィールドは3つだけです。「Species」と「Code」の2つのフィールドは、フィールドデータの入力を容易にするために「MasterVegList」と呼ばれる別のテーブルからの情報を参照します。

エンドユーザーがフォームと「MasterVegList」テーブルに新しい種を追加できるようにするために、次のVBAコードを記述しました。

Private Sub Code_NotInList(NewData As String, Response As Integer)
Dim strTmp As String

    'Get confirmation that this is not just a spelling error.
    strTmp = "Add '" & NewData & "' as a new category?"
    If MsgBox(strTmp, vbYesNo + vbDefaultButton2 + vbQuestion, "Not in list") = vbYes Then

        'Append the NewData as a record in the Categories table.
        strTmp = "INSERT INTO MasterVegList ( Code ) " & _
            "SELECT """ & NewData & """ AS Code;"
        DBEngine(0)(0).Execute strTmp, dbFailOnError

        'Notify Access about the new record, so it requeries the combo.
        Response = acDataErrAdded
    End If
End Sub

Private Sub Species_NotInList(NewData As String, Response As Integer)
Dim strTmp As String

    'Get confirmation that this is not just a spelling error.
    strTmp = "Add '" & NewData & "' as a new category?"
    If MsgBox(strTmp, vbYesNo + vbDefaultButton2 + vbQuestion, "Not in list") = vbYes Then

        'Append the NewData as a record in the Categories table.
        strTmp = "INSERT INTO MasterVegList ( Species ) " & _
            "SELECT """ & NewData & """ AS Species;"
        DBEngine(0)(0).Execute strTmp, dbFailOnError

        'Notify Access about the new record, so it requeries the combo.
        Response = acDataErrAdded
    End If
End Sub

問題は、新しい種が入力されると、MasterVegListテーブルの種とコードの両方に対して新しいレコードが作成されることです。種とコードの両方を同じレコードに入力する必要があります。フォームを使用して入力することを目的としたテーブルではなく、MasterVegListテーブルを参照していることに注意してください。

エリックA

新しい種が入力された場合はコードの入力をユーザーに求めることができ、新しいコードが入力された場合は種を求めることができます。

Private Sub Code_NotInList(NewData As String, Response As Integer)
Dim strTmp As String

    'Get confirmation that this is not just a spelling error.
    strTmp = "Add '" & NewData & "' as a new category?"
    If MsgBox(strTmp, vbYesNo + vbDefaultButton2 + vbQuestion, "Not in list") = vbYes Then
        Dim strInput As String
        strInput = InputBox("What's the species?")
        'Append the NewData as a record in the Categories table.
        strTmp = "INSERT INTO MasterVegList ( Code, Species ) " & _
            "VALUES(""" & NewData  & """, """ & strInput  & """);"
        CurrentDb.Execute strTmp, dbFailOnError

        'Notify Access about the new record, so it requeries the combo.
        Response = acDataErrAdded
        Me.Species.Requery
    End If
End Sub

Private Sub Species_NotInList(NewData As String, Response As Integer)
Dim strTmp As String

    'Get confirmation that this is not just a spelling error.
    strTmp = "Add '" & NewData & "' as a new category?"
    If MsgBox(strTmp, vbYesNo + vbDefaultButton2 + vbQuestion, "Not in list") = vbYes Then
        Dim strInput As String
        strInput = InputBox("What's the code?")
        'Append the NewData as a record in the Categories table.
        strTmp = "INSERT INTO MasterVegList ( Code, Species ) " & _
            "VALUES(""" & strInput  & """, """ & NewData  & """);"
        CurrentDb.Execute strTmp, dbFailOnError

        'Notify Access about the new record, so it requeries the combo.
        Response = acDataErrAdded
        Me.Code.Requery
    End If
End Sub

ユーザーが実際に有効な入力を入力したことを確認したい場合がありますが、読者の練習問題として残しておきます。

また、次のことも変更しました：のINSERT INTO ... VALUES ...代わりにINSERT INTO ... SELECT使用し、のCurrentDb代わりに使用するDbEngine(0)(0)

また、これらのクエリをパラメータ化して、ユーザーがフィールドに引用符を入力できるようにすることもできます。

この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。

侵害の場合は、連絡してください[email protected]

編集2021-08-7

コメントを追加

サインイン

Related 関連記事

記事