ACCESS VBA编程（五）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
     For Each tbl In cat.Tables
     Debug.Print tbl.name
         For Each pro In tbl.Properties
             Debug.Print pro.name & "=" & pro.value
         Next
         If tbl.name = "需要隐藏的表名" Then tbl.Properties.Item("Jet OLEDB:Table Hidden In Access") = True
     Next
End Sub
如何用VBA代码更改表中字段的数据类型或加字段
使用Alter COLUMN改变一个当前字段的数据类型，需要指定字段名、新数据类型、还可以 (对文本和二进制字段)指定长度。
改字段
alter table 你的表名 alter column 你的字段名 数据类型
例如，下列语句把雇员表中一个字段的数据类型, 被称为ZipCode（最初被定义为整数），改变成一个10字符文本字段：
CurrentDb.Execute "Alter TABLE 地址 Alter COLUMN sz TEXT(22)"
改为逻辑型：
CurrentDb.Execute "Alter TABLE 地址 Alter COLUMN sz BIT"
日期时间：
CurrentDb.Execute "Alter TABLE 地址 Alter COLUMN sz date"
备注型：
CurrentDb.Execute "Alter TABLE 地址 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 的长整型数。
decimal 17 个字节 容纳从 1028 - 1到 - 1028 - 1. 的值的精确的数字数据类型。你可以定义精度 (1 - 28) 和 符号 (0 - 定义精度)。缺省精度和符号分别是18和0
加字段
CurrentDb.Execute "Alter Table 地址 Add Column 字段三 Char(2)"
CurrentDb.Execute "Alter Table 地址 Add Column 字段1 BIT"
如何用sql语句添加删除主键？
来源：access911.net
Function AddPrimaryKey()
'添加主键到[编号]字段
Dim strSQL As String
strSQL = "Alter TABLE 表1 ADD CONSTRAINT PRIMARY_KEY " _
& "PRIMARY KEY (编号)"
CurrentProject.Connection.Execute strSQL
End Function
Function DropPrimaryKey()
'删除主键
Dim strSQL As String
strSQL = "Alter TABLE 表1 Drop CONSTRAINT PRIMARY_KEY "
CurrentProject.Connection.Execute strSQL
End Function
SQL--JOIN之完全用法

外联接。外联接可以是左向外联接、右向外联接或完整外部联接。
在 FROM 子句中指定外联接时，可以由下列几组关键字中的一组指定：
LEFT JOIN 或 LEFT OUTER JOIN。
左向外联接的结果集包括 LEFT OUTER 子句中指定的左表的所有行，而不仅仅是联接列所匹配的行。如果左表的某行在右表中没有匹配行，则在相关联的结果集行中右表的所有选择列表列均为空值。
RIGHT JOIN 或 RIGHT OUTER JOIN。
右向外联接是左向外联接的反向联接。将返回右表的所有行。如果右表的某行在左表中没有匹配行，则将为左表返回空值。
FULL JOIN 或 FULL OUTER JOIN。
完整外部联接返回左表和右表中的所有行。当某行在另一个表中没有匹配行时，则另一个表的选择列表列包含空值。如果表之间有匹配行，则整个结果集行包含基表的数据值。
仅当至少有一个同属于两表的行符合联接条件时，内联接才返回行。内联接消除与另一个表中的任何行不匹配的行。而外联接会返回 FROM 子句中提到的至少一个表或视图的所有行，只要这些行符合任何 Where 或 HAVING 搜索条件。将检索通过左向外联接引用的左表的所有行，以及通过右向外联接引用的右表的所有行。完整外部联接中两个表的所有行都将返回。
Microsoft® SQL Server™ 2000 对在 FROM 子句中指定的外联接使用以下 SQL-92 关键字：
LEFT OUTER JOIN 或 LEFT JOIN
        RIGHT OUTER JOIN 或 RIGHT JOIN
        FULL OUTER JOIN 或 FULL JOIN
SQL Server 支持 SQL-92 外联接语法，以及在 Where 子句中使用 *= 和 =* 运算符指定外联接的旧式语法。由于 SQL-92 语法不容易产生歧义，而旧式 Transact-SQL 外联接有时会产生歧义，因此建议使用 SQL-92 语法。

使用左向外联接
假设在 city 列上联接 authors 表和 publishers 表。结果只显示在出版商所在城市居住的作者（本例中为 Abraham Bennet 和 Cheryl Carson）。
若要在结果中包括所有的作者，而不管出版商是否住在同一个城市，请使用 SQL-92 左向外联接。下面是 Transact-SQL 左向外联接的查询和结果：
USE pubs
Select a.au_fname, a.au_lname, p.pub_name
FROM authors a LEFT OUTER JOIN publishers p
ON a.city = p.city
orDER BY p.pub_name ASC, a.au_lname ASC, a.au_fname ASC
下面是结果集：
au_fname au_lname pub_name
------------------- ------------------------------ -----------------
Reginald Blotchet-Halls NULL
Michel DeFrance NULL
Innes del Castillo NULL
Ann Dull NULL
Marjorie Green NULL
Morningstar Greene NULL
Burt Gringlesby NULL
Sheryl Hunter NULL
Livia Karsen NULL
Charlene Locksley NULL
Stearns MacFeather NULL
Heather McBadden NULL
Michael O'Leary NULL
Sylvia Panteley NULL
Albert Ringer NULL
Anne Ringer NULL
Meander Smith NULL
Dean Straight NULL
Dirk Stringer NULL
Johnson White NULL
Akiko Yokomoto NULL
Abraham Bennet Algodata Infosystems
Cheryl Carson Algodata Infosystems
(23 row(s) affected)
不管是否与 publishers 表中的 city 列匹配，LEFT OUTER JOIN 均会在结果中包含 authors 表的所有行。注意：结果中所列的大多数作者都没有相匹配的数据,因此，这些行的 pub_name 列包含空值。

使用右向外联接
假设在 city 列上联接 authors 表和 publishers 表。结果只显示在出版商所在城市居住的作者（本例中为 Abraham Bennet 和 Cheryl Carson）。SQL-92 右向外联接运算符 RIGHT OUTER JOIN 指明：不管第一个表中是否有匹配的数据，结果将包含第二个表中的所有行。
若要在结果中包括所有的出版商，而不管城市中是否还有出版商居住，请使用 SQL-92 右向外联接。下面是 Transact-SQL 右向外联接的查询和结果：
USE pubs
Select a.au_fname, a.au_lname, p.pub_name
FROM authors AS a RIGHT OUTER JOIN publishers AS p
ON a.city = p.city
orDER BY p.pub_name ASC, a.au_lname ASC, a.au_fname ASC
下面是结果集：
au_fname au_lname pub_name
-------------------- ------------------------ --------------------
Abraham Bennet Algodata Infosystems
Cheryl Carson Algodata Infosystems
NULL NULL Binnet & Hardley
NULL NULL Five Lakes Publishing
NULL NULL GGG&G
NULL NULL Lucerne Publishing
NULL NULL New Moon Books
NULL NULL Ramona Publishers
NULL NULL Scootney Books
(9 row(s) affected)
使用谓词（如将联接与常量比较）可以进一步限制外联接。下例包含相同的右向外联接，但消除销售量低于 50 本的书籍的书名：
USE pubs
Select s.stor_id, s.qty, t.title
FROM sales s RIGHT OUTER JOIN titles t
ON s.title_id = t.title_id
AND s.qty > 50
orDER BY s.stor_id ASC
下面是结果集：
stor_id qty title
------- ------ ---------------------------------------------------------
(null) (null) But Is It User Friendly?
(null) (null) Computer Phobic AND Non-Phobic Individuals: Behavior
Variations
(null) (null) Cooking with Computers: Surreptitious Balance Sheets
(null) (null) Emotional Security: A New Algorithm
(null) (null) Fifty Years in Buckingham Palace Kitchens
7066 75 Is Anger the Enemy?
(null) (null) Life Without Fear
(null) (null) Net Etiquette
(null) (null) Onions, Leeks, and Garlic: Cooking Secrets of the
Mediterranean
(null) (null) Prolonged Data Deprivation: Four Case Studies
(null) (null) Secrets of Silicon Valley
(null) (null) Silicon Valley Gastronomic Treats
(null) (null) Straight Talk About Computers
(null) (null) Sushi, Anyone?
(null) (null) The Busy Executive's Database Guide
(null) (null) The Gourmet Microwave
(null) (null) The Psychology of Computer Cooking
(null) (null) You Can Combat Computer Stress!
(18 row(s) affected)

使用完整外部联接
若要通过在联接结果中包括不匹配的行保留不匹配信息，请使用完整外部联接。Microsoft® SQL Server™ 2000 提供完整外部联接运算符 FULL OUTER JOIN，不管另一个表是否有匹配的值，此运算符都包括两个表中的所有行。
假设在 city 列上联接 authors 表和 publishers 表。结果只显示在出版商所在城市居住的作者（本例中为 Abraham Bennet 和 Cheryl Carson）。SQL-92 FULL OUTER JOIN 运算符指明：不管表中是否有匹配的数据，结果将包括两个表中的所有行。
若要在结果中包括所有作者和出版商，而不管城市中是否有出版商或者出版商是否住在同一个城市，请使用完整外部联接。下面是 Transact-SQL 完整外部联接的查询和结果：
USE pubs
Select a.au_fname, a.au_lname, p.pub_name
FROM authors a FULL OUTER JOIN publishers p
ON a.city = p.city
orDER BY p.pub_name ASC, a.au_lname ASC, a.au_fname ASC
下面是结果集：
au_fname au_lname pub_name
-------------------- ---------------------------- --------------------
Reginald Blotchet-Halls NULL
Michel DeFrance NULL
Innes del Castillo NULL
Ann Dull NULL
Marjorie Green NULL
Morningstar Greene NULL
Burt Gringlesby NULL
Sheryl Hunter NULL
Livia Karsen NULL
Charlene Locksley NULL
Stearns MacFeather NULL
Heather McBadden NULL
Michael O'Leary NULL
Sylvia Panteley NULL
Albert Ringer NULL
Anne Ringer NULL
Meander Smith NULL
Dean Straight NULL
Dirk Stringer NULL
Johnson White NULL
Akiko Yokomoto NULL
Abraham Bennet Algodata Infosystems
Cheryl Carson Algodata Infosystems
NULL NULL Binnet & Hardley
NULL NULL Five Lakes Publishing
NULL NULL GGG&G
NULL NULL Lucerne Publishing
NULL NULL New Moon Books
NULL NULL Ramona Publishers
NULL NULL Scootney Books
(30 row(s) affected)

金额阿拉伯数字转换为中文的存储过程
Private Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function
'名称： ChMoney
'得到数字 N1 的汉字大写
'最大为 千万位
'O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000
If N1 = 0 Then
ChMoney = " "
Exit Function
End If
If N1 < 0 Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""
If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If ST1 <> "" Then
t1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s1 = s1 + CCh(Val(t1)) + "角"
End If
If ST1 <> "" Then
t1 = Left(ST1, 1)
s1 = s1 + CCh(Val(t1)) + "分"
End If
End If
ST1 = Left(tMoney, tn - 1)
Else
ST1 = tMoney
End If
s2 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(t1)) + s2
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
s3 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(t1)) + s3
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If
ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)
End Function

金额阿拉伯数字转换为中文的存储过程
也谈此内容。
以下同:
Private Function Num2Char(ByVal i As Integer) As String
If i >= 0 And i <= 9 Then
Num2Char = Mid$("零壹贰叁肆伍陆柒捌玖", i + 1, 1)
Else
Num2Char = ""
End If
End Function
Private Function Num2RMB(ByVal sFourBitString As String, Optional _
ByVal sUnit As String = "元", Optional ByVal bMustHeader As _
Boolean = False) As String
'----------------------------------------------------------------------
Dim vNum, i, RX, BR, hdr
'------------------------------------------------------------------
BR = "仟佰拾元"
'------------------------------------------------------------------
vNum = Trim(Str(Val(sFourBitString))) ' 最多四位
'------------------------------------------------------------------
If (Len(vNum) < 4 And Len(vNum) > 0) And bMustHeader Then hdr = "零" _
Else hdr = ""
RX = ""
Do While Len(vNum) > 0
i = Right(vNum, 1)
If i > 0 Then
RX = Num2Char(i) + Right(BR, 1) + RX
Else
If Left(RX, 1) <> "零" Then RX = "零" + RX
End If
vNum = Left(vNum, Len(vNum) - 1)
BR = Left(BR, Len(BR) - 1)
Loop
RX = Left(RX, Len(RX) - 1)
If Right(RX, 1) = "零" Then ' 去除多余的零
RX = Left(RX, Len(RX) - 1)
End If
If Len(RX) > 0 Then
Num2RMB = hdr + RX + sUnit
Else
Num2RMB = RX + IIf(sUnit = "元", "元", "")
End If
End Function
Function GetDXJE(ByVal num As Currency) As String ' 得到大写金额
'----------------------------------------------------------------------
Dim vNum, vDec, ret, qb
'------------------------------------------------------------------
vNum = Right(Format(Int(num), "000000000000"), 12) ' 取十二位整数
vDec = Right(Format(Int(num * 100 + 0.5), "00"), 2) ' 取小数点后两位并自动四舍五入
'------------------------------------------------------------------
ret = Num2RMB(Left(vNum, 4), "亿", False)
If Len(ret) = 0 Then
ret = Num2RMB(Mid(vNum, 5, 4), "万", False)
Else
ret = ret + Num2RMB(Mid(vNum, 5, 4), "万", True)
End If
If Len(ret) = 0 Then
ret = Num2RMB(Right(vNum, 4), "元", False)
Else
ret = ret + Num2RMB(Right(vNum, 4), "元", True)
End If
'------------------------------------------------------------------
If ret = "元" Then
ret = ""
qb = ""
Else
qb = "xx"
End If
'------------------------------------------------------------------
If vDec = "00" And qb <> "" Then '1.00
ret = ret + "整"
End If
If vDec = "00" And qb = "" Then '0.00
ret = "(无金额)"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb <> "" Then '1.20
ret = ret + Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb <> "" Then '1.03
ret = ret + "零" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb <> "" Then '1.23
ret = ret + Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb = "" Then '0.20
ret = Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb = "" Then '0.03
ret = Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb = "" Then '0.23
ret = Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
GetDXJE = ret
'----------------------------------------------------------------------
End Function