'按键盘 ALT + F11 转到 VBA 编辑器界面,菜单 插入 模块,然后将一下代码 COPY 进去 '点击鼠标左键,将光标停留在各个函数的名称上按 F5 可以执行该函数
'=========================================================== ' 过程及函数名: CreateTempDate ' 版本号 : 1.0 ' 说明 : 本函数作用:建立本文章需要的测试环境(表) ' 引用 : -- ' 输入参数 : -- ' 输出值 : -- ' 返回值 : -- ' 调用演示 : -- ' 最后修改日期: 2006-9-14 16:32:00 ' 示例地址 : http://access911.net/?kbid;72FABE1E11DCE8F3 ' 作者 : cg1 ' 网站 : http://access911.net ' 电子邮件 : access911@gmail.com '===========================================================
Function CreateTempDate() '本函数作用:建立本文章需要的测试环境(表)
Dim strSQL(6) As String Dim i As Long strSQL(0) = "drop table tblName" strSQL(1) = "drop table temp" strSQL(2) = "create table tblName (ID LONG,Name text(50),Address text(50))" strSQL(3) = "insert into tblName(ID,NAME,ADDRESS) VALUES(1,'王午','上海')" strSQL(4) = "insert into tblName(ID,NAME,ADDRESS) VALUES(3,'立嗣','上海')" strSQL(5) = "insert into tblName(ID,NAME,ADDRESS) VALUES(45,'苏俄','上海')" strSQL(6) = "create table temp (ID AUTOINCREMENT(2,4),Name text(50),Address text(50),Primary KEY ([ID]))" On Error Resume Next For i = 0 To UBound(strSQL) CurrentProject.Connection.Execute strSQL(i) If Err <> 0 Then Debug.Print "语句 strSQL(" & CStr(i) & ") 运行出错:" & Err.Description Err.Clear End If Next End Function
'=========================================================== ' 过程及函数名: DoAlterTable ' 版本号 : 1.0 ' 说明 : 本函数作用:利用 JET DB 的特性更改已有数据字段的数据类型为“自动编号”“递增” ' 引用 : -- ' 输入参数 : -- ' 输出值 : -- ' 返回值 : -- ' 调用演示 : -- ' 最后修改日期: 2006-9-14 16:32:00 ' 示例地址 : http://access911.net/?kbid;72FABE1E11DCE8F3 ' 作者 : cg1 ' 网站 : http://access911.net ' 电子邮件 : access911@gmail.com '===========================================================
Function DoAlterTable() '本函数作用:利用 JET DB 的特性更改已有数据字段的数据类型为“自动编号”“递增” Dim strSQL As String strSQL = "insert into temp (ID,NAME,ADDRESS) SELECT id,name,address from tblName" CurrentProject.Connection.Execute strSQL '如果是纯 ACCESS 环境可以使用 'DoCmd.Rename "新表名", acTable, "原表名" '来更改表名 renameTableName "tblName", "tblName-" & Format(Now, "yyyymmddhhnnss") renameTableName "temp", "tblName" End Function
'=========================================================== ' 过程及函数名: renameTableName ' 版本号 : 1.0 ' 说明 : 本函数作用,更改某个用户表的名称 ' 引用 : ADOX ' 输入参数 : strOldName 文本,修改前的名称 ' strNewName 文本,修改后的表名称 ' 输出值 : -- ' 返回值 : Boolean 确定是否成功更名 ' 调用演示 : renameTableName "tblName", "tblName-" & Format(Now, "yyyymmddhhnnss") ' 最后修改日期: 2006-9-14 16:32:00 ' 示例地址 : http://access911.net/?kbid;72FABE1E11DCE8F3 ' 作者 : cg1 ' 网站 : http://access911.net ' 电子邮件 : access911@gmail.com '===========================================================
Function renameTableName(strOldName As String, strNewName As String) As Boolean '本函数作用,更改某个用户表的名称
On Error Resume Next 'Dim tbl As ADOX.Table '在 ACCESS 环境中可以这样声明 'Dim cat As New ADOX.Catalog '在 ACCESS 环境中可以这样声明 Dim tbl Dim cat Set tbl = CreateObject("adox.table") Set cat = CreateObject("adox.catalog") Set cat.ActiveConnection = CurrentProject.Connection '上面这句中 CurrentProject.Connection 在VB中要更改为已经open的connection对象 For Each tbl In cat.Tables If tbl.Name = strOldName Then tbl.Name = strNewName Next If Err.Number <> 0 Then renameTableName = False Else renameTableName = True End If End Function |