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