Access - VBA编程（使用技巧大全）[1](7)

ACCESS-VBA编程

Function MSA_SimpleGetSaveFileName() As String Dim msaof As MSA_OPENFILENAME Dim intRet As Integer Dim strRet As String

intRet = MSA_GetSaveFileName(msaof) If intRet Then

strRet = msaof.strFullPathReturned End If

MSA_SimpleGetSaveFileName = strRet End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer Dim of As OPENFILENAME Dim intRet As Integer MSAOF_to_OF msaof, of

intRet = GetOpenFileName(of) If intRet Then

OF_to_MSAOF of, msaof End If

MSA_GetOpenFileName = intRet End Function

Function MSA_SimpleGetOpenFileName() As String Dim msaof As MSA_OPENFILENAME Dim intRet As Integer Dim strRet As String

intRet = MSA_GetOpenFileName(msaof) If intRet Then

strRet = msaof.strFullPathReturned End If

MSA_SimpleGetOpenFileName = strRet End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)

msaof.strFullPathReturned = left(of.lpstrFile, InStrB(of.lpstrFile, vbNullChar) - 1) msaof.strFileNameReturned = of.lpstrFileTitle msaof.intFileOffset = of.nFileOffset

msaof.intFileExtension = of.nFileExtension End Sub

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME) Dim strFile As String * 512

of.hwndOwner = Application.hWndAccessApp of.hInstance = 0

of.lpstrCustomFilter = 0 of.nMaxCustrFilter = 0 of.lpfnHook = 0

of.lpTemplateName = 0 of.lCustrData = 0

If msaof.strFilter = \

of.lpstrFilter = MSA_CreateFilterString(ALLFILES) Else

of.lpstrFilter = msaof.strFilter End If

26

ACCESS-VBA编程

of.nFilterIndex = msaof.lngFilterIndex of.lpstrFile = msaof.strInitialFile _

& String(512 - Len(msaof.strInitialFile), 0) of.nMaxFile = 511

of.lpstrFileTitle = String(512, 0) of.nMaxFileTitle = 511

of.lpstrTitle = msaof.strDialogTitle of.lpstrInitialDir = msaof.strInitialDir of.lpstrDefExt = msaof.strDefaultExtension of.Flags = msaof.lngFlags of.lStructSize = Len(of) End Sub

Function FindNorthwind(strSearchPath) As String Dim msaof As MSA_OPENFILENAME

msaof.strDialogTitle = conDialogTitle msaof.strInitialDir = strSearchPath

msaof.strFilter = MSA_CreateFilterString(\ MSA_GetOpenFileName msaof

FindNorthwind = Trim(msaof.strFullPathReturned) End Function

Function MSAMachineName() As String Dim lngLen As Long, lngx As Long Dim strCompName As String lngLen = 16

strCompName = String$(lngLen, 0)

lngx = apiGetComputerName(strCompName, lngLen) If lngx <> 0 Then

MSAMachineName = left$(strCompName, lngLen) Else

MSAMachineName = \ End If End Function

应用：

Private Sub Command43_Click() Dim strFileName As String

strFileName = FindNorthwind(\MsgBox strFileName End Sub

查看当前库的路径 方法1.

= CurrentProject.Path 方法2.

Dim DBLongname, DBName, DBDir As String DBLongname = CodeDb.Name DBName = Dir(DBLongname)

DBDir = Left(DBLongname, Len(DBLongname) - Len(DBName)) MsgBox \数据库所在目录：\获取路径、文件名、扩展名 'ResultFlag=0 获取路径 'ResultFlag=1 获取文件名

27

ACCESS-VBA编程

'ResultFlag=2 获取扩展名

Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String Dim SplitPos As Integer, DotPos As Integer SplitPos = InStrRev(FullPath, \DotPos = InStrRev(FullPath, \Select Case ResultFlag Case 0

SplitPath = Left(FullPath, SplitPos - 1) Case 1

If DotPos = 0 Then DotPos = Len(FullPath) + 1

SplitPath = Mid(FullPath, SplitPos + 1, DotPos - SplitPos - 1) Case 2

If DotPos = 0 Then DotPos = Len(FullPath) SplitPath = Mid(FullPath, DotPos + 1) Case Else

Err.Raise vbObjectError + 1, \End Select End Function

数据库与照片的关系如何处理？

有照片若干，怎样能在数据库中存储并显示？

1、把照片放进数据库，照片的格式最好是bmp，这样就可以在窗体上显示出来，不过这样数据库的体积会暴增。设一个OLE字段，然后插入对象就行了（对着字段单击右键）

2、不把照片放入数据库，只把照片的路径保存到数据库中，动态加载，这样可以支持很多种图片格式。（见示例）

If Dir(Application.CurrentProject.Path & \ Me!照片.Picture = Application.CurrentProject.Path & \Else

Me!照片.Picture = Application.CurrentProject.Path & \End If

导出成EXECL表

DoCmd.TransferSpreadsheet acExport, 8, \6、如何建立简单的超级连接？ *API函数声明

Private Declare Function ShellExecute Lib \ng, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd A s Long) As Long 注释：打开某个网址

ShellExecute 0, \http://tyvb.126.com\注释：给某个信箱发电子邮件

ShellExecute hwnd, \

ACCESS表

用ADO编程隐藏表 sub hide_table()

Dim cnn As New ADODB.Connection Dim cat As New ADOX.Catalog

Set cat.ActiveConnection = CurrentProject.Connection Dim tbl As ADOX.Table Dim pro As Property

28

ACCESS-VBA编程

For Each tbl In cat.Tables Debug.Print tbl.name

For Each pro In tbl.Properties

Debug.Print pro.name & \ Next

If tbl.name = \需要隐藏的表名

\ Next End Sub

删除外数据库mdb的所有表或一个表

DoCmd.DeleteObject acTable, \表名\，如果是连接表，并不能“删除外数据库mdb的所有表或一个表”。 不妨调用下面的子过程试试： Sub sbDeleteAllTables() Dim db As Database Dim td As TableDef

Set db = OpenDatabase(\ For Each td In db.TableDefs

If (td.Attributes And dbSystemObject) = 0 Then '不可删除系统表 db.Execute \ End If Next

db.TableDefs.Refresh Set td = Nothing Set db = Nothing End Sub

如何用VBA代码更改表中字段的数据类型或加字段 使用ALTER COLUMN改变一个当前字段的数据类型，需要指定字段名、新数据类型、还可以 (对文本和二进制字段)指定长度。 改字段

alter table 你的表名 alter column 你的字段名 数据类型

例如，下列语句把雇员表中一个字段的数据类型, 被称为ZipCode（最初被定义为整数），改变成一个10字符文本字段：

CurrentDb.Execute \地址 ALTER COLUMN sz TEXT(22)\改为逻辑型：

CurrentDb.Execute \地址 ALTER COLUMN sz BIT\日期时间：

CurrentDb.Execute \地址 ALTER COLUMN sz date\备注型：

CurrentDb.Execute \地址 ALTER COLUMN sz memo\货币：

money 8 个字节 介于 – 922,337,203,685,477.5808 到 922,337,203,685,477.5807 之间的符号整数。 real 4 个字节 单精度浮点数，负数范围是从 –3.402823e38 到 –1.401298e-45，正数从1.401298e-45 到 3.402823e38，和 0。 float 8 个字节 双精度浮点数，负数范围是从 –1.79769313486232e308 到 –4.94065645841247e-324，正数从 4.94065645841247e-324 到 1.79769313486232e308，和 0。 smallint 2 个字节 介于 –32,768 到 32,767 的短整型数。

integer 4 个字节 介于 –2,147,483,648 到 2,147,483,647 的长整型数。

29

ACCESS-VBA编程

decimal 17 个字节 容纳从 1028 - 1到 - 1028 - 1. 的值的精确的数字数据类型。你可以定义精度 (1 - 28) 和 符号 (0 - 定义精度)。缺省精度和符号分别是18和0

加字段

CurrentDb.Execute \地址 Add Column 字段三 Char(2)\CurrentDb.Execute \地址 Add Column 字段1 BIT\如何用sql语句添加删除主键？ 来源：access911.net Function AddPrimaryKey() '添加主键到[编号]字段 Dim strSQL As String

strSQL = \表1 ADD CONSTRAINT PRIMARY_KEY \& \编号)\

CurrentProject.Connection.Execute strSQL End Function

Function DropPrimaryKey() '删除主键

Dim strSQL As String

strSQL = \表1 Drop CONSTRAINT PRIMARY_KEY \CurrentProject.Connection.Execute strSQL End Function

用VBA代码建立表间字段的关系

转自：爱赛思应用俱乐部 gglddqccdc Sub CreateRelationX()

Dim relNew As Relation With CurrentDb

Set relNew = .CreateRelation(\表2表1ID编号\表2\表1\dbRelationUnique) 'dbRelationUnique)表示一对一

relNew.Fields.Append relNew.CreateField(\ relNew.Fields!ID.ForeignName = \编号\ .Relations.Append relNew .Close End With End Sub

用ADO打开链接表

这是我以前十分头痛的问题，不知道那一堆一串的是什么意思现在知道了，这个是打开ACCESS的，打开别的表不在此讨论之内。

Dim appAccess As ADODB.Connection Dim strCn, temp As String Dim cat As ADOX.Catalog

Dim rstEmployees As ADODB.Recordset Dim intloop As Integer

Dim tbl1, tblEmp As ADOX.Table Dim idx As ADOX.Index

strCn = \ & \；\Set appAccess = New ADODB.Connection appAccess.Open strCn

Set cat = New ADOX.Catalog

30

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库Access - VBA编程（使用技巧大全）[1](7)在线全文阅读。