求助：如何把多重选择列表框的选择记录追加到表

zj167304

卡住了～已经卡住1个星期了～

在网站找了下面一篇文章，对我的启发很大。但是我毫无基础，根本看不明白，特别是For Each那里！
有高手能给解释一下吗？如果能够把多重选择列表框的记录追加到1张表呢？谁能给我附一下实例附件，感激不尽，已经卡住1星期了
Option Compare Database
'作 者: 竹笛
'发布日期：2004-4-11
'摘 要: 利用列表框的多重选择来输出选定结果
Private Sub cmdSome_Click()
    Dim strWhere As String, varItem As Variant
    ' 如果没有选择项目,则退出程序
    If Me!lstBname.ItemsSelected.Count = 0 Then Exit Sub
    '选择项目
    For Each varItem In Me!lstBname.ItemsSelected
        strWhere = strWhere & Chr$(34) & Me!lstBname.Column(0, varItem) & Chr$(34) & ","
    Next varItem
        strWhere = Left$(strWhere, Len(strWhere) - 1)
    gstrWhereBook = "[物资代码] IN (" & strWhere & ")"
    '在所打开的窗体中应用筛选条件
    DoCmd.OpenForm FormName:="frmBooks", WhereCondition:=gstrWhereBook
End Sub

zj167304

如何能把选中的记录追加到另一张表呢

Henry D. Sy

Private Sub Command3_Click()
    Dim strWhere As String
    Dim varI As Variant
    Dim strSQL As String
    If Me.lstBname.ItemsSelected.Count = 0 Then
        MsgBox "Select the Item Frist!!"
        Exit Sub
    End If
    For Each varI In Me.lstBname.ItemsSelected
        strWhere = strWhere & "'" & Me.lstBname.ItemData(varI) & "',"
    Next
    strSQL = "SELECT tblBook.* INTO Newtbl FROM tblBook WHERE ISBNNumber In (" & strWhere & ")"
    CurrentDb.Execute strSQL
End Sub

zj167304

感谢Henry D. Sy 版主～
For Each varI In Me.lstBname.ItemsSelected
        strWhere = strWhere & "'" & Me.lstBname.ItemData(varI) & "',"
    Next
这里我一直不明白

Henry D. Sy

可以自定义一个函数来判断Newtbl是否存在？存在即删除。
当然可以改成追加查询
For Each varI In Me.lstBname.ItemsSelected
        strWhere = strWhere & "'" & Me.lstBname.ItemData(varI) & "',"
    Next
将你选择的循环叠加在一起，详细请看帮助。

zj167304

感谢Henry D. Sy 版主～
我弄好了，虽然代码不明白，终于能用了，太高兴了

Henry D. Sy

追加的：

Private Sub Command3_Click()
    Dim strWhere As String
    Dim varI As Variant
    Dim strSQL As String
    If Me.lstBname.ItemsSelected.Count = 0 Then
        MsgBox "Select the Item Frist!!"
        Exit Sub
    End If
    For Each varI In Me.lstBname.ItemsSelected
        strWhere = strWhere & "'" & Me.lstBname.ItemData(varI) & "',"
    Next
    strSQL = _
    "INSERT INTO Newtbl ( ISBNNumber, Book ) SELECT tblBook.ISBNNumber, tblBook.Book FROM tblBook WHERE ISBNNumber In (" _
           & strWhere & ")"
    CurrentDb.Execute strSQL
End Sub

Henry D. Sy

自定义函数的

Public Function IsHere(strTblName As String) As Boolean
    Dim tbl As DAO.TableDef
    Dim bln As Boolean
    bln = False
    For Each tbl In CurrentDb.TableDefs
        If tbl.Name = strTblName Then
            bln = True
            Exit For
        End If
    Next
    IsHere = bln
End Function

Private Sub Command3_Click()
    Dim strWhere As String
    Dim varI As Variant
    Dim strSQL As String
    If Me.lstBname.ItemsSelected.Count = 0 Then
        MsgBox "Select the Item Frist!!"
        Exit Sub
    End If
    If IsHere("Newtbl") Then
        DoCmd.DeleteObject acTable, "Newtbl"
    End If
    For Each varI In Me.lstBname.ItemsSelected
        strWhere = strWhere & "'" & Me.lstBname.ItemData(varI) & "',"
    Next
    strSQL = "SELECT tblBook.* INTO Newtbl FROM tblBook WHERE ISBNNumber In (" & strWhere & ")"
    CurrentDb.Execute strSQL
End Sub

jszhw

多谢楼主分享！！！

yanwei82123300

非常感谢6D老师制作的范例，对我会有莫大帮助，牛