档案馆模型库系统的VB实现

分类：VB作者：佚名

公共变量：

Public cnn As ADODB.Connection
Public rs As ADODB.Recordset

Form1：

Private Sub Form_load()
    '建立与模型库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"  '数据库驱动程序
        .Open "D:\档案模型系统.mdb"
    End With
    '查找模型库中的模型，并设置给“模型清单”列表框
    Call 获取模型清单
End Sub

Public Sub 获取模型清单()
    '获取模型库中的表
    Set rs = cnn.OpenSchema(adSchemaTables)
    With 模型清单
        .Clear
        Do Until rs.EOF
            If Left(rs!table_name,4) <> "MSys" Then  '系统表不显示
                模型清单.AddItem rs!table_name
            End If
            rs.MoveNext
        Loop
    End With
End Sub

Private Sub 查找模型_Click()
    '指定要查找模型的名称
    myNewName = InputBox("请输入要查找的模型名称：","输入模型名称")
    If Len(Trim(myNewName)) = 0 Then 'Trim(str)，去掉str两边的空格
        MsgBox "没有输入有效的模型名！",vbCritical
        Exit Sub
    End If
    '检查模型库中是否有同名模型
    Set rs = cnn.OpenSchema(adSchemaTables) '语法：Set 记录集对象名= connection.OpenSchema(QueryType,Criteria,SchemaID)，参数：QueryType 所要运行的模式查询类型可以是一系列常量，比如adSchemaColumns
    Do Until rs.EOF
        If LCase(rs!table_name) = LCase(myNewName) Then
            模型清单.Text = rs!table_name
            MsgBox "找到模型：" & myNewName
            Exit Sub
        End If
        rs.MoveNext
    Loop
    If rs.EOF = True Then
        MsgBox "没有找到模型：" & myNewName & " ！",vbCritical,"警告"
    End If
End Sub

    Private Sub 创建模型_Click()
        Form2.Show   '打开“创建模型窗体”子窗体
        Call 获取模型清单    '刷新“模型清单”列表框
    End Sub

    Private Sub 打开模型_Click()
        '判断是否选择了要打开的模型
        If 模型清单.ListIndex = -1 Then
            MsgBox "没有选择要打开的模型！","警告"
            Exit Sub
        End If
        '打开选择的模型
        Dim myAccess As Object  'Object 数据类型保存引用对象的 32 位（4 字节）地址。可以为 Object 的变量分配任何引用类型（字符串、数组、类或接口）。Object 变量还可以引用任何值类型（数值、Boolean、Char、Date、结构或枚举）的数据。
        Set myAccess = CreateObject("D:\档案模型系统.mdb")
        With myAccess
            .Visible = True
            .DoCmd.OpenTable 模型清单.Text  'DoCmd 对象方法的任务是打开和关闭Access对象
            .DoCmd.Maximize
        End With
        '释放变量
        Set myAccess = nothing
    End Sub

    Private Sub 复制模型_Click()
        Dim sql As String,myNewName As String
        '判断是否选择了要复制的模型
        If 模型清单.ListIndex = -1 Then
            MsgBox "没有选择要复制的模型！","警告"
            Exit Sub
        End If
        '确认是否复制选择的模型
        If MsgBox("是否要复制模型<" & 模型清单.Text & ">？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
begin:
        '指定模型的新名称
        myNewName = InputBox("请输入模型新名称：","输入模型名称")
        If Len(Trim(myNewName)) = 0 Then
            MsgBox "没有输入有效的模型名！",vbCritical
            Exit Sub
        End If
        '检查模型库中是否有同名模型
        Set rs = cnn.OpenSchema(adSchemaTables)
        Do Until rs.EOF
            If LCase(rs!table_name) = LCase(myNewName) Then
                MsgBox "模型<" & myNewName & ">已经存在！请重新输入模型名！",_
                    vbCritical,"警告"
                GoTo begin
                Exit Sub
            End If
            rs.MoveNext
        Loop
        '生成一个查询表
        sql = "select * into " & myNewName & " from " & 模型清单.Text
        Set rs = cnn.Execute(sql)
        MsgBox "将模型<" & 模型清单.Text & ">复制了一份。名称为<" _
            & myNewName & ">",vbinformation + vbOKOnly,"复制模型"
        '刷新“模型清单”列表框
        Call 获取模型清单
        '删除“字段清单”列表框中的项目
        字段清单.Clear
    End Sub

    Private Sub 改变字段长度_Click()
        Dim sql As String,myFieldType As String
        '判断是否选择了要改变字段长度的字段
        If 字段清单.ListIndex = -1 Then
            MsgBox "没有选择要改变字段长度的字段！","警告"
            Exit Sub
        End If
        '确认是否改变选择字段的长度
        If MsgBox("是否改变字段<" & 字段清单.Text & ">的长度？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
begin:
        '指定字段新类型
        myFieldType = InputBox("请输入字段类型及长度：","输入字段类型及长度")
        If Len(Trim(myFieldType)) = 0 Then
            MsgBox "没有输入有效的字段类型和长度！",vbCritical
            Exit Sub
        End If
        '改变选择字段的模型类型
        sql = "alter table " & 模型清单.Text & " alter " _
            & 字段清单.Text & Space(1) & myFieldType
        Set rs = New ADODB.Recordset
        rs.Open sql,cnn,adOpenDynamic,adLockOptimistic  '游标类型，加锁类型  ADOPENDYNAMIC(=2) 可读写,当前数据记录可自由移动   ADLOCKOPTIMISTIC(=3) 乐观锁定 ，直到用Update方法提交更新记录时才锁定记录。
        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _
            & 字段清单.Text & ">的长度被改变！",_
            vbinformation + vbOKOnly,"改变字段长度"
    End Sub

    Private Sub 改变字段类型_Click()
        Dim sql As String,myFieldType As String
        '判断是否选择了要改变模型类型的字段
        If 字段清单.ListIndex = -1 Then
            MsgBox "没有选择要改变模型类型的字段！","警告"
            Exit Sub
        End If
        '确认是否改变选择字段的模型类型
        If MsgBox("是否改变字段<" & 字段清单.Text & ">的模型类型？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
begin:
        '指定字段新类型
        myFieldType = InputBox("请输入字段新类型：","输入字段新类型")
        If Len(Trim(myFieldType)) = 0 Then
            MsgBox "没有输入有效的字段类型！",adLockOptimistic
        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _
            & 字段清单.Text & ">的类型被改变！","改变字段类型"
    End Sub

    Private Sub 删除模型_Click()
        Dim sql As String
        '判断是否选择了要删除的模型
        If 模型清单.ListIndex = -1 Then
            MsgBox "没有选择要删除的模型！","警告"
            Exit Sub
        End If
        '确认是否删除选择的模型
        If MsgBox("是否要删除模型<" & 模型清单.Text & ">？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
        '删除选定的模型
        sql = "drop table " & 模型清单.Text
        Set rs = cnn.Execute(sql)
        MsgBox "模型<" & 模型清单.Text & ">被成功删除！","删除模型"
        '刷新“模型清单”列表框
        Call 获取模型清单
        '删除“字段清单”列表框中的项目
        字段清单.Clear
    End Sub

    Private Sub 删除字段_Click()
        Dim sql As String
        '判断是否选择了要删除的字段
        If 字段清单.ListIndex = -1 Then
            MsgBox "没有选择要删除的字段！","警告"
            Exit Sub
        End If
        '确认是否删除选择的字段
        If MsgBox("是否要删除字段<" & 字段清单.Text & ">？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
        '删除选定的字段
        sql = "alter table " & 模型清单.Text & " drop " & 字段清单.Text
        Set rs = New ADODB.Recordset
        rs.Open sql,adLockOptimistic
        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _
            & 字段清单.Text & ">被成功删除！","删除模型"
        '刷新“字段清单”列表框
        Call 获取字段清单
    End Sub
Private Sub 模型清单_Click()
        Call 获取字段清单
End Sub
Public Sub 获取字段清单()
        On Error Resume Next
        Dim sql As String,i As Integer
        '查询选择的模型，将字段名清单设置给“字段清单”列表框
        sql = "select * from " & 模型清单.Text
        Set rs = cnn.Execute(sql)
        With 字段清单
            .Clear
            For i = 0 To rs.Fields.Count - 1
                .AddItem rs.Fields(i).Name
            Next i
        End With
        rs.Close
End Sub
Private Sub 刷新_Click()
    Call 获取模型清单
End Sub

    Private Sub 添加字段_Click()
        Dim sql As String,myNewField As String
        '判断是否选择了要添加字段的模型
        If 模型清单.ListIndex = -1 Then
            MsgBox "没有选择要添加字段的模型！","警告"
            Exit Sub
        End If
begin:
        '指定新字段名称
        myNewField = InputBox("请输入新字段名称和类型：","输入新字段名称类型")
        If Len(Trim(myNewField)) = 0 Then
            MsgBox "没有输入有效的字段名！",vbCritical
            Exit Sub
        End If
        '确认是否添加字段
        If MsgBox("是否要向模型<" & 模型清单.Text _
            & ">中添加字段<" & myNewField & ">？",_
            vbQuestion + vbYesNo) = vbNo Then Exit Sub
        '检查模型中是否有同名的字段
        Set rs = cnn.OpenSchema(adSchemaColumns)
        Do Until rs.EOF
            If LCase(rs!column_name) = LCase(myNewField) Then
               MsgBox "在模型<" & 模型清单 & ">中已经存在字段< " _
                & myNewField & ">！","警告"
                GoTo begin
                Exit Sub
            End If
            rs.MoveNext
        Loop
        '添加字段
        sql = "alter table " & 模型清单.Text & " add " & myNewField
        Set rs = New ADODB.Recordset
        rs.Open sql,adLockOptimistic
        MsgBox "在模型<" & 模型清单.Text & ">中成功添加了字段<" _
            & myNewField,"删除模型"
        '刷新“字段清单”列表框
        Call 获取字段清单
    End Sub

    Private Sub 退出系统_Click()
        cnn.Close
        Set rs = nothing
        Set myCat = nothing
        Set cnn = nothing
        Unload Form1
    End Sub

Private Sub 重命名模型_Click()
    Dim sql As String,myNewName As String
    '判断是否选择了要重命名的模型
    If 模型清单.ListIndex = -1 Then
        MsgBox "没有选择要重命名的模型！","警告"
        Exit Sub
    End If
    '确认是否删除选择的模型
    If MsgBox("是否要重命名模型<" & 模型清单.Text & ">？",_
        vbQuestion + vbYesNo) = vbNo Then Exit Sub
begin:
    '指定模型的新名称
    myNewName = InputBox("请输入模型新名称：","输入模型名称")
    If Len(Trim(myNewName)) = 0 Then
        MsgBox "没有输入有效的模型名！",vbCritical
        Exit Sub
    End If
    '检查模型库中是否有同名模型
    Set rs = cnn.OpenSchema(adSchemaTables)
    Do Until rs.EOF
        If LCase(rs!table_name) = LCase(myNewName) Then
            MsgBox "模型<" & myNewName & ">已经存在！请重新输入模型名！",_
                vbCritical,"警告"
            GoTo begin
            Exit Sub
        End If
        rs.MoveNext
    Loop
    '生成一个查询表
    sql = "select * into " & myNewName & " from " & 模型清单.Text
    Set rs = cnn.Execute(sql)
    '删除原来的模型
    sql = "drop table " & 模型清单.Text
    Set rs = cnn.Execute(sql)
    MsgBox "成功将模型<" & 模型清单.Text & ">名称改为<" _
        & myNewName & ">","模型重命名"
    '刷新“模型清单”列表框
    Call 获取模型清单
    '删除“字段清单”列表框中的项目
    字段清单.Clear
End Sub
Private Sub 字段清单_Click()
        Call 获取字段信息
End Sub
Public Sub 获取字段信息()
        Dim sql As String,i As Integer
        '查询选择的模型
        sql = "select * from " & 模型清单.Text
        Set rs = New ADODB.Recordset
        rs.Open sql,adOpenKeyset,adLockOptimistic
        '将字段名称、类型和大小输出到有关文字框
        字段名称.Text = rs.Fields(字段清单.Text).Name
        字段类型 = getType(rs.Fields(字段清单.Text).Type)
        字段长度 = rs.Fields(字段清单.Text).DefinedSize
End Sub
Function getType(num)
   getType = num
   Select Case num
     Case "202":
       getType = "文本"  'nvarchar(255) 可以  nvarchar 数据类型用作变长的统一编码字符型数据。此数据类型能存储4000种字符，使用的字节空间增加了一倍
     Case "203":
       getType = "备注"  'ntext(536870910) 可以  ntext 数据类型用来存储大量的统一编码字符型数据。这种数据类型能存储230 -1或将近10亿个字符，且使用的字节空间增加了一倍
     Case "3":
       getType = "长整型"  'int(4) 不可以  int 数据类型可以存储从- 231(-2147483648)到231 (2147483 647)之间的整数。存储到数据库的几乎所有数值型的数据都可以用这种数据类型。这种数据类型在数据库里占用4个字节
     Case "2":
       getType = "整型"    'smallint(2)  不可以 smallint 数据类型可以存储从- 215(-32768)到215(32767)之间的整数。这种数据类型对存储一些常限定在特定范围内的数值型数据非常有用。这种数据类型在数据库里占用2 字节空间
     Case "17":
       getType = "字节"    'tinyint(1)  不可以  tinyint 数据类型能存储从0到255 之间的整数。它在你只打算存储有限数目的数值时很有用。 这种数据类型在数据库中占用1 个字节
     Case "4":
       getType = "单精浮点"    'real(4)   不可以   real 数据类型像浮点数一样，是近似数值类型。它可以表示数值在-3.40E+38到3.40E+38之间的浮点数
     Case "5":
       getType = "双精浮点"    'float(8)   不可以  float 数据类型是一种近似数值类型，供浮点数使用。说浮点数是近似的，是因为在其范围内不是所有的数都能精确表示。浮点数可以是从-1.79E+308到1.79E+308 之间的任意数
     Case "7":
       getType = "日期/时间"   'datetime(8)   不可以 datetime数据类型用来表示日期和时间。这种数据类型存储从1753年1月1日到9999年12月3 1日间所有的日期和时间数据， 精确到三百分之一秒或3.33毫秒
     Case "6":
       getType = "货币"    'money(8)  不可以  money 数据类型用来表示钱和货币值。这种数据类型能存储从-9220亿到9220 亿之间的数据，精确到货币单位的万分之一
     Case "11":
       getType = "是/否"    'bit(2)  不可以   bit 数据类型是整型，其值只能是0、1或空值。这种数据类型用于存储只有两种可能值的数据，如Yes 或No、True 或Fa lse 、On 或Off
   End Select
End Function



Form2：

Private Sub Form_load()
        字段字符串.Text = "示例：  字段1 nvarchar(10) primary key,字段2 datetime,字段3 float"
End Sub
    Private Sub 字段字符串_Enter()
        字段字符串.Text = ""
    End Sub
    Private Sub 取消_Click()
        Unload Form2
    End Sub
    Private Sub 确定_Click()
        Dim sql As String
        '检查模型库中是否有同名模型
        Set rs = cnn.OpenSchema(adSchemaTables)
        Do Until rs.EOF
            If LCase(rs!table_name) = LCase(模型名.Text) Then
                MsgBox "模型<" & mytable & ">已经存在！请重新输入模型名！"
                模型名.Text = ""
                模型名.SetFocus
                Exit Sub
            End If
            rs.MoveNext
        Loop
        '创建模型
        sql = "create table " & 模型名.Text & Space(1) & "(" & 字段字符串.Text & ")"
        Set rs = cnn.Execute(sql)
        MsgBox "模型创建成功！",vbinformation,"创建模型"
        Unload Form2
    End Sub



Form4：

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

VB Format函数
Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 -------------------------------- 数字类型的格式化 --------------------------------     固定格式参数：     General Number 普通数字，如可以用来去掉千位分隔号     format$("100,1
vb6/ASP FORMAT MM/DD/YYYY
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式，竟然没有好的办法， Format 或者FormatDateTime 竟然结果和系统设置的区域语言的日期和时间格式相关。意思是尽管你用诸如 Format(Now, "MM/dd/yyyy")，如果系统的设置格式区域语言的日期和时间格式分隔符是"-",那他还会显示为 MM-dd-yyyy     只有拼凑： <%response.write
VB.net 捕获项目全局异常
在项目中添加如下代码：新建窗口来显示异常信息。 Namespace My ‘全局错误处理，新的解决方案直接添加本ApplicationEvents.vb 到工程即可 ‘添加后还需要一个From用来显示错误。如果到这步还不会则需要先打好基础啦 ‘======================================================== ‘以下事件
实现用VB.Net/(C#)开发K/3 BOS 插件的真正可行方法
转了这一篇文章，原来一直想用C#做k3的插件开发，vb没有C#用的爽呀，这篇文章写与2011年，看来我以前没有认真去找这个方法呀。 https://blog.csdn.net/chzjxgd/article/details/6176325 金蝶K3 BOS的插件官方是用VB6编写的，如果  能用.Net下的语言工具开发BOS插件是一件很愉快的事情，其中缘由不言而喻，而本文则是个人首创，实现在了用V
vb，wps，excel 分裂
Sub 分列() ‘以空格为分隔符，连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗？请确定分列的数据会覆盖它后面的单元格！", _
VB文件 hash 查看器
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim path As String, hash As String 3 For Each fil
VB.NET MYSQL DataGridView 增删改查INSERT,SELECT,UPDATE,DELETE
  Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS Dim conString As String = "Server=localhost;Database=net2;Uid=root;Pwd=123456;" Dim con As New MySqlConnection
VB.NET 使用ADODB連接資料庫滙出到EXCEL
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop   Private Sub A1() Dim Sql As String Dim Cnn As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim S As String   S = "Provider=OraOLEDB.Oracl
vb.net 多线程運用 ping
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class Form1 Dim A(254) As String    Function ping(ByVal IP As Integer) As String Dim IPAddress As String IPAddress = "10.0.
VB等待进程结束
VB运行EXE程序，并等待其运行结束 参考：https://blog.csdn.net/useway/article/details/5494084 Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Pr
vb中去掉string数组的一部分
今天碰到一个问题，登陆的时候，如果不需要验证手机号为空，则不去验证手机号 因为登陆的时候所有的验证信息都存放在一个数组里 Dim CheckUserInfo() As String ={UserBirthday, SecEmail, UserMob, UserSex, RealNameFirst, RealName, CheckCardID, CheckCardType, Contactemail
VB如何连接SQL Server数据库
在VB6.0中，数据访问接口有三种： 1、ActiveX数据对象（ADO） 2、远程数据对象（RDO） 3、数据访问对象（DAO） 1.使用ADO（ActiveX Data Objec，ActiveX数据对象）连接SQL Server 1）使用ADO控件连接 使用ADO控件的ConnectionString属性就可以连接SQL Server，该属性包含一个由分号分隔的argument=value语
Visual Basic 6.0VB6.0详细安装过程
注：大家如果没有VB6.0的安装文件，可自行百度一下下载，一般文件大小在200M左右的均为完整版的软件，可以使用。   特别提示：安装此软件的时候最好退出360杀毒软件（包括360安全卫士，电脑管家等，如果电脑上有这些软件的话），因为现如今的360杀毒软件直接会对VB6.0软件误报，这样的话就可能会在安装过程中被误报阻止而导致安装失败，或者是安装后缺乏很多必须的组件（其它的杀毒软件或安全卫士之类的
使用VB6读取数据库资源并发送邮件原创
Private Sub Form_Load() Call conndb End Sub Private Function conndb() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strCn, sql As String Dim db_host As String Dim db_user As String
POS VB
  PPSM06S70:  Add  moddate  EDITSPRINTJOB:  MAX(TO_CHAR(ETRN.MODDATE, ‘yyyy/mm/dd/HH24:MI AM‘)) ACTUAL_SHIPDATE   4.Test Scenario (1) ：Query SQL Test DN:8016578337 SELECT CTRN.TKCTID TRUCK_ID,        
vb.net 水晶報表CrystalReport 動態設定資料庫來源
  沒有出現CrystalReportViewer時,須安裝CRforVS_13_0. 新增1個數據集,新增1個數據表,添加二列,列名要和資料庫名一樣. 修改目標Framework 修改app.config, <startup >改成<startup useLegacyV2RuntimeActivationPolicy ="true">  CrystalReport1.rpt增加數據庫專家 在表單
VB.net 与线程
Imports System.Threading Imports System Public Class Form1 Dim th1, th2 As Thread Public Sub Method1() Dim i As Integer For i = 1 To 100 If Me.Label1.BackColor =
vb.net Process32First和Module32First
Friend Const PROCESS_ALL_ACCESS = &H1F0FFF = 2035711 Friend Const PROCESS_VM_READ = &H10 Friend Const PROCESS_VM_WRITE = &H20 Friend Const PAGE_READONLY = &H2 Friend Const PAGE_READWRITE = &H4 Friend
vb.net 分割byte数组的方法SplitBytes
以下代码随手写的 并没有大量测试 效率也有待提升 如果需要C#的请自行转换 Function SplitBytes(Data As Byte(), Delimiter As Byte()) As List(Of Byte()) Dim i = 0 Dim List As New List(Of Byte()) Dim bytes As New
VB.NET连接SQL_Server实例
Imports System.Data.SqlClient Public Class Form1 REM Public conn1 As SqlConnection = New SqlConnection("server=.; Integrated Security=False;Initial Catalog= mydatabase1; User ID= sa;password")
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot