[求助]编程获取字段的方法

阿丰

我设计了一个窗体，放有两个下拉列表框，第一个框要列出数据库中所有的表（或链接表）及查询的名称，第二个框根据第一个框中的名称，要得出该表（或查询）的所有字段名称。用VBA应如何实现？请各位指教。

zhengjialon

表名和查询名：SELECT MSysObjects.Name, MSysObjects.Type
FROM MSysObjects
WHERE (((MSysObjects.Name) Like "*" And (MSysObjects.Name) Not Like "~*") AND ((MSysObjects.Type)=1 Or (MSysObjects.Type)=5));

字段名:
Private Function GETZD(tbName As String)
    Dim cat As New ADOX.Catalog
    cat.ActiveConnection = CurrentProject.Connection
    For i = 0 To cat.Tables(tbName).Columns.Count - 1
        Debug.Print cat.Tables(tbName).Columns.Item(i).Name
    Next
End Function

'需引用ADOX
'用法：GETZD ("表名")

[此贴子已经被作者于2004-2-12 15:50:19编辑过]

阿丰

谢了，字段名如何获取？

太感谢了！

[此贴子已经被作者于2004-2-12 16:09:47编辑过]

zhuyiwen

以下是引用阿丰在2004-2-12 15:03:24的发言：
我设计了一个窗体，放有两个下拉列表框，第一个框要列出数据库中所有的表（或链接表）及查询的名称，第二个框根据第一个框中的名称，要得出该表（或查询）的所有字段名称。用VBA应如何实现？请各位指教。

在窗体上放两个列表框控件, 分别为 lstTV  lstFld, 用来分别显示表/查询列表和字段列表

lstTV的属性设置:
行来源类型:表/查询
行来源:SELECT Name FROM MSysObjects WHERE (((MSysObjects.Name) Not Like "~*") AND ((MSysObjects.Name) Not Like "Msys*") AND ((MSysObjects.Type)=1 Or (MSysObjects.Type)=5));
列数:1

lstFld的属性设置:
行来源类型:字段列表
列数:1

在lstTV的更新后事件处理程序中写入如下代码:
Private Sub lstTV_AfterUpdate()
    lstFld.RowSource = lstTV
End Sub

运行效果如下图:

huanghai

字段名还可以使用ADO得到
DIM RST AS ADODB。RECORDSET
DIM STR AS STRING
。。。

FOR I = 0 TO RST。FIELDS。COUNT-1
STR = STR & RST.FIELDS(I).NAME
NEXT I

XXX.ROWSOURCE =STR '字符串还要修剪

阿丰

我试过了，第4楼的方法太好了，多谢多谢！

zhuyiwen

以下是引用aydl1014在2004-2-14 11:30:16的发言：
请问如何在此基础上选择几个字段生成一个新表？

在第4贴的基础上, 在窗体上增加一个复选框和一个命令按钮, 分别命名为chkData和cmdGen, 并将原来的lstFld的多重选择属性设置为“简单”，然后，在该窗体中添加如下代码：

Public strSQL As String

Private Sub cmdGen_Click()
    Dim strTblName As String
   
    If strSQL = "" Then
        MsgBox "没有选择字段！", vbCritical, Me.Caption
    Else
        strTblName = InputBox("请输入新建的表的名称:", "新建表", "新表1")
        If strTblName = "" Then
    '        MsgBox "已取消操作！", vbCritical, Me.Caption
        Else
            If Not IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & strTblName & "' AND [Type]=1")) Then
                MsgBox "表：" & strTblName & vbCr & vbCr & "已经存在！", vbCritical, Me.Caption
            Else
                If chkData Then
                    ' 含有数据
                    DoCmd.RunSQL strSQL & " INTO [" & strTblName & "] FROM [" & lstTV & "];"
                Else
                    ' 不含数据
                    DoCmd.RunSQL strSQL & " INTO [" & strTblName & "] FROM [" & lstTV & "] WHERE 1=2;"
                End If
            End If
        End If
    End If
End Sub

Private Sub lstFld_AfterUpdate()
    Dim varFld As Variant
   
    strSQL = ""
    For Each varFld In lstFld.ItemsSelected
        strSQL = strSQL & ", " & "[" & lstFld.ItemData(varFld) & "]"
    Next
    strSQL = IIf(strSQL = "", "", "SELECT" & Mid(strSQL, 2))
   
    Debug.Print strSQL
End Sub

运行效果如下图，即可实现“在此基础上选择几个字段生成一个新表”。

ququ

太经典了，谢谢朱大师

zhuyiwen

修正新增数据表后, 对lstTV数据表和查询列表框的更新:

第8贴的cmdGen_Click()改为如下:

Private Sub cmdGen_Click()
    Dim strTblName As String
   
    If strSQL = "" Then
        MsgBox "没有选择字段！", vbCritical, Me.Caption
    Else
        strTblName = InputBox("请输入新建的表的名称:", "新建表", "新表1")
        If strTblName = "" Then
    '        MsgBox "已取消操作！", vbCritical, Me.Caption
        Else
            If Not IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & strTblName & "' AND [Type]=1")) Then
                MsgBox "表：" & strTblName & vbCr & vbCr & "已经存在！", vbCritical, Me.Caption
            Else
                If chkData Then
                    ' 含有数据
                    DoCmd.RunSQL strSQL & " INTO [" & strTblName & "] FROM [" & lstTV & "];"
                Else
                    ' 不含数据
                    DoCmd.RunSQL strSQL & " INTO [" & strTblName & "] FROM [" & lstTV & "] WHERE 1=2;"
                End If

                ' 修正新增数据表后, 对lstTV数据表和查询列表框的更新
                ' --------------------------------------------------
                lstTV.Requery
                ' --------------------------------------------------
            End If
        End If
    End If
End Sub