表名和查询名: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
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
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))
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