万能查询frm.frm

Mdb数据库万能查询 功能强大 功能:智能查询、模拟查询当前目录下*.mdb数据库文件

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7230
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8505
   LinkTopic       =   "Form1"
   ScaleHeight     =   7230
   ScaleWidth      =   8505
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command5 
      Caption         =   "Command5"
      Height          =   255
      Left            =   2040
      TabIndex        =   7
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   255
      Left            =   2040
      TabIndex        =   6
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   375
      Left            =   2040
      TabIndex        =   5
      Top             =   1200
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   375
      Left            =   2040
      TabIndex        =   4
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   1920
      TabIndex        =   3
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   0
      Left            =   120
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   600
      Width           =   1455
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   2175
      Left            =   960
      TabIndex        =   0
      Top             =   2760
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   3836
      _Version        =   393216
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'##############################################################################################
'#####　　　　　　功能:智能查询、模拟查询当前目录下*.mdb数据库文件， 　　　　　　　　　 　#####
'#####　　　　　　　　 可把查询结果用电子表格打开编辑，也可把打印查询结果。 　　　　　　　#####
'#####　　　　　　浙江磐安文化　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　#####
'#####　　　　　　E:[e-mail]　　　　　　　　　　　　　　　　　　　　　　　　　　#####
'##############################################################################################
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'1、加入Label1和Text1二控件，设置其Index均为0　　　　　　　　　　　　　　　　　　　　　　　 　'
'2、加入Command1Command2、Command3、Command4、Command5按钮　　　　　　　　　　　　　　　　　　'
'3、加入MSFlexGrid1              　　　　　　　　　　　　　　　　　　　　　　　　　　　　　   '
'4、引用Microsoft Scriping Runtime 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 　'
'5、引用Microsoft DAO 3.60 Object Library，其中Access97为Microsoft DAO 3.51 Object Library　　'
'6、引用Microsoft Excel 9.0 Object Library，其中Excel97为Microsoft Excel 8.0 Object Library  　　　　　　　　　　　　　　　　　　 '
'再用以下代码完全覆盖　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 　'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim MyAppPath As String '数据库路径
    Dim MyRecordsetName As String '数据表名称
    Dim MyDatabasePathAndName As String '数据库路径及名称
    Dim s As String '暂存由用户界面所输入的SQL语句
    Dim MyTxt As String '写入的是“查询.txt”还是“打印.txt”
    Dim RstFieldsType() As Integer '记录字段的类型
    Dim MyDatabaseFieldsCount As Integer '数据表字段数
    Dim MyDatabaseRecordCount As Double '数据表记录数
    Dim FieldLookValue As Boolean '核对数据类型
    Dim MyViewBoolean As Boolean '预览否


Private Sub Form_Load()
    '初始化
    If Right$(App.Path, 1) <> "\" Then
        MyAppPath = App.Path & "\"
    Else
        MyAppPath = App.Path
    End If
    
    If Dir(MyAppPath + "*.mdb") = "" Then
        MsgBox "当前位置没（*.mdb）数据库文件，请增加！！！", 48, "差错信息！！！"
        Unload Me
        Exit Sub
    End If
    
    '历遍当前目录下的数据库（暂时少于20个）供其选择，若只有1个，直接用之。
    Dim MyMdb(1 To 20) As String
    
    i = 1
    MyFile = Dir(MyAppPath + "*.mdb")
    Do Until MyFile = "" Or i > 20
        MyMdb(i) = MyFile
        'MsgBox MyMdb(i)
        MyFile = Dir
        i = i + 1
    Loop
        
    If i - 1 > 1 Then '当前目录下存在多个Mdb数据库时，供其选择！
        Dim MyInputBox As String
        For j = 1 To i - 1
            MyInputBox = MyInputBox & j & "、“" & MyMdb(j) & "”" & Chr(13)
        Next
        MyInputBox = InputBox(MyInputBox & Chr(13) _
            & "——请在下面输入数据库的序号——" _
            , "当前目录下有多个数据库，请选择数据库！")
        
        If StrPtr(MyInputBox) = 0 Then '用户取消操作
            MsgBox "你选择取消操作！！！", 48, "提示信息！！！"
            Unload Me
            Exit Sub
        ElseIf Not IsNumeric(MyInputBox) Then
            MsgBox "你输入的不是数字！！！", 48, "提示信息！！！"
            Unload Me
            Exit Sub
        ElseIf MyInputBox < 1 Or MyInputBox > i Then
            MsgBox "你输入的数字不在范围内！！！", 48, "提示信息！！！"
        End If
    
            MyDatabasePathAndName = MyAppPath + MyMdb(MyInputBox)
    ElseIf i - 1 = 1 Then
        MyDatabasePathAndName = MyAppPath + Dir(MyAppPath + "*.mdb")
    End If
    
    Dim dbs As Database, rst As Recordset
    Set dbs = OpenDatabase(MyDatabasePathAndName)
    
    '历遍当前数据库下的数据表（暂时少于20个）供其选择，若只有1个，直接用之。
    Dim MyRs(1 To 20) As String
    i = 1
    For Each j In dbs.TableDefs
        MyRecordsetName = j.Name
        If Left(MyRecordsetName, 4) <> "MSys" Then ' Exit For  '查找数据表名称
            MyRs(i) = MyRecordsetName
            'MsgBox MyRs(i)
            i = i + 1
        End If
    Next

    If i - 1 > 1 Then '数据库下存在多个数据表时，供其选择！
        MyInputBox = ""
        For j = 1 To i - 1
            MyInputBox = MyInputBox & j & "、“" & MyRs(j) & "”" & Chr(13)
        Next
        MyInputBox = InputBox(MyInputBox & Chr(13) _
            & "——请在下面输入数据表的序号——" _
            , "当前数据库下有多个数据表，请选择数据表！")
        
        If StrPtr(MyInputBox) = 0 Then '用户取消操作
            MsgBox "你选择取消操作！！！", 48, "提示信息！！！"
            Unload Me
            Exit Sub
        ElseIf Not IsNumeric(MyInputBox) Then
            MsgBox "你输入的不是数字！！！", 48, "提示信息！！！"
            Unload Me
            Exit Sub
        ElseIf MyInputBox < 1 Or MyInputBox > i Then
            MsgBox "你输入的数字不在范围内！！！", 48, "提示信息！！！"
        End If
            MyRecordsetName = MyRs(MyInputBox)
    ElseIf i - 1 = 1 Then
        MyRecordsetName = MyRs(1)
    End If
    
    Set rst = dbs.OpenRecordset(MyRecordsetName)
    MyDatabaseFieldsCount = rst.Fields.Count '字段数
    MyDatabaseRecordCount = rst.RecordCount '记录数
    
    With MSFlexGrid1
        .Cols = MyDatabaseFieldsCount
        .Rows = 2
        .AllowUserResizing = flexResizeColumns '允许用户调整列宽
        .Row = 0
        .Col = 0
        .FixedCols = 0
        .Left = 360
        .Width = (Screen.Width - MSFlexGrid1.Left) * 0.98
        .ToolTipText = "单击数据网格时，将在条件输入处显示当前行数据；双击数据网格时，将按列排序！"
    End With
      
    For i = 1 To MyDatabaseFieldsCount - 1
        Load Label1(i)
        Label1(i).Visible = True
        Load Text1(i)
        Text1(i).Visible = True
    Next
    
    ReDim RstFieldsType(0 To MyDatabaseFieldsCount - 1)
    For jj = 1 To Int((MyDatabaseFieldsCount + 4) / 5)
        For ii = 1 To 5
            i = (jj - 1) * 5 + (ii - 1)
            
            If i < MyDatabaseFieldsCount Then
                 iiiii = Screen.Width / Screen.TwipsPerPixelX / 800 '按800*600的屏幕像素进行伸缩
                 With Label1(i)
                    .Caption = rst.Fields(i).Name
                    .Height = 250 * iiiii
                    .Top = 120 * iiiii + (jj - 1) * 600 * iiiii
                    .Width = (12000 - 360 * 2) * iiiii / 5
                    .Left = 360 * iiiii + (12000 - 360 * 2) * iiiii / 5 * (ii - 1)
                    .Alignment = 2
                 End With
                 With Text1(i)
                    .Text = ""
                    .Height = 300 * iiiii
                    .Top = 350 * iiiii + (jj - 1) * 600 * iiiii
                    .Width = (12000 - 360 * 2) * iiiii / 5
                    .Left = 360 * iiiii + (12000 - 360 * 2) * iiiii / 5 * (ii - 1)
                    .ToolTipText = "你若在“" _
                        & Label1(i).Caption _
                        & "”处输入条件，按“查询”按扭或者按回车后将显示结果！！！"
                 End With
            
                 RstFieldsType(i) = rst.Fields(i).Type
                 
                 With MSFlexGrid1
                     .ColWidth(i) = 11208 * iiiii / MyDatabaseFieldsCount
                     .Col = i: MSFlexGrid1.Text = rst.Fields(i).Name
                 End With
            End If
        Next
    Next

    With Me
        .Left = 0
        .Top = 0
        .Height = Screen.Height
        .Width = Screen.Width
        .Caption = "数据库（" _
            & Dir(MyDatabasePathAndName) _
            & "）————" & "表（" _
            & MyRecordsetName _
            & "）————查出" & 0 & "条记录"
    End With
    With Command1
        .Left = 3460
        .Caption = "电子表格形式打开(&O)"
        .Top = 450 + Text1(MyDatabaseFieldsCount - 1).Top
        .Height = 495: Command1.Width = 1215
        .ToolTipText = "按此按扭，将在以电子表格形式打开查询结果！！！"
        .Enabled = False
    End With
    With Command2
        .Left = 4780
        .Caption = "打印报表(&P)"
        .Top = Command1.Top
        .Height = 495
        .Width = 1215
        .ToolTipText = "按此按扭，将打印报表！！！打印前，先调整数据网格各列的合适宽度！！！"
        .Enabled = False
    End With
    With Command3
        .Left = 6100
        .Caption = "查询(&F)"
        .Top = Command1.Top
        .Height = 495
        .Width = 1215
        .ToolTipText = "按此按扭，将在下面显示查询结果！！！"
    End With
    With Command4
        .Caption = "清除(&D)"
        .Left = 7420
        .Top = Command1.Top
        .Height = 495
        .Width = 1215
        .ToolTipText = "按此按扭，将清除输入条件！！！"
        .Enabled = False
    End With
    With Command5
        .Left = 8740
        .Caption = "退出(&Q)"
        .Top = Command1.Top
        .Height = 495
        .Width = 1215
        .ToolTipText = "按此按扭，将退出程序！！！"
   End With
    
    With MSFlexGrid1 '动态调整顶端与高度
        .Top = 650 + Command1.Top
        .Height = (Screen.Height - MSFlexGrid1.Top) * 0.85
    End With
        
    rst.Close
    dbs.Close