ACCESS VBA编程（八）ACCESS VBA技巧

来源:www.accessoft.com 点击数:36691 　 | 收藏 | 复制

时　间:2013-01-29 10:12:41
作　者:周芳 ID：24526 城市：上海
摘　要:Vba技巧
正　文:

显示窗体“第n条记录共m条记录”的函数
调用方法：
=RecordNumber("第",me)'me指当前窗体
可在文框的控件来源中写：=RecordNumber("第",forms!当前窗体名)
在代码的窗体成为当前事件中写：me.文本框=RecordNumber("第", Me)
结果虽相同，但在代码中的要快！
但是，在代码的窗体成为当前事件中写：Me.标签.Caption = RecordNumber("第", Me)
用标签，速度明显要比前两个用法还要快！

Function RecordNumber(pstrPreFix As String, pfrm As Form) As String
On Error GoTo RecordNumber_Err
Dim rst
Dim lngNumRecords As Long
Dim lngCurrentRecord As Long
Dim strTmp As String

Set rst = pfrm.RecordsetClone
rst.MoveLast
rst.Bookmark = pfrm.Bookmark
lngNumRecords = rst.RecordCount
lngCurrentRecord = rst.AbsolutePosition + 1
strTmp = pstrPreFix & " " & lngCurrentRecord & " 页，" & " 共 " & lngNumRecords & " " & "页"
RecordNumber_Exit:
On Error Resume Next
RecordNumber = strTmp
rst.Close
Set rst = Nothing
Exit Function
RecordNumber_Err:
Select Case Err
Case 3021
strTmp = "New Record"
Resume RecordNumber_Exit
Case Else
strTmp = "#" & Error
Resume RecordNumber_Exit
End Select
End Function
获取ACCESS错误号与对应的中文解释
Sub MMM()
For e = 1 To 100
Debug.Print e; " - "; Error(e)
Next
End Sub
执行上述代码将显示如下结果：
1 - 应用程序定义或对象定义错误
2 - 应用程序定义或对象定义错误
3 - 无 GoSub 返回
4 - 应用程序定义或对象定义错误
5 - 无效的过程调用或参数
6 - 溢出
7 - 内存溢出

对话框返回文本框内容
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
InputBox 函数的语法具有以下几个命名参数：
Prompt：必需的。作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符，由所用字符的宽度决定。如果 prompt 包含多个行，则可在各行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或回车换行符的组合 (Chr(13) & Chr(10)) 来分隔。
Title：可选的。显示对话框标题栏中的字符串表达式。如果省略 title，则把应用程序名放入标题栏中。
Default：可选的。显示文本框中的字符串表达式，在没有其它输入时作为缺省值。如果省略 default，则文本框为空。
Xpos：可选的。数值表达式，成对出现，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos，则对话框会在水平方向居中。
Ypos：可选的。数值表达式，成对出现，指定对话框的上边与屏幕上边的距离。如果省略 ypos，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。
Helpfile：可选的。字符串表达式，识别帮助文件，用该文件为对话框提供上下文相关的帮助。如果已提供 helpfile，则也必须提供 context。
Context: 可选的。数值表达式，由帮助文件的作者指定给某个帮助主题的帮助上下文编号。如果已提供 context，则也必须要提供 helpfile。

示例：
本示例说明使用 InputBox 函数来显示用户输入数据的不同用法。如果省略 x 及 y 坐标值，则会自动将对话框放置在两个坐标的正中。如果用户单击“确定”按钮或按下“ENTER”按键，则变量 MyValue 保存用户输入的数据。如果用户单击“取消”按钮，则返回一零长度字符串。
Dim Message, Title, Default, MyValue
Message = "Enter a value between 1 and 3"    ' 设置提示信息。
Title = "InputBox Demo"    ' 设置标题。
Default = "1"    ' 设置缺省值。
' 显示信息、标题及缺省值。
MyValue = InputBox(Message, Title, Default)

' 使用帮助文件及上下文。“帮助”按钮便会自动出现。
MyValue = InputBox(Message, Title, , , , "DEMO.HLP", 10)

' 在 100, 100 的位置显示对话框。
MyValue = InputBox(Message, Title, Default, 100, 100)

根据屏幕分辨率自动调整窗体大小：
Option Compare Database
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub Form_Open(Cancel As Integer)
Dim x As Long, y As Long, a As Long, b As Long
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
a = 10000 / 800 * x
b = 7000 / 600 * y
DoCmd.MoveSize 1134, 1134, a, b
End Sub

获得系统的屏幕区域大小
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Sub Command0_Click()
Dim x As Long, y As Long
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
MsgBox x & " " & y
End Sub

让控件自适应屏幕分辨率
'这个函数可以使你开发的程序适应各种分辨率，这是我见过的最完美的解决方案！强列推荐
''如果你是在1024*768的分辨率下写的程序，就把下面那句改为
Const DesignSize = 1024，如果是800*600分
'辨率下写的，就改为Const DesignSize = 800
'用法：把下面所有的代码放在一个模块里，在需要适应分辨率的窗体的Load事
'件里加入Call FormResiz_OnOpen(Me)
'
'Const DesignSize = 1024
Const DesignSize = 800
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
'国标码宣言
Dim frm As Form
Dim ctrl As Control
Dim prp As Property
Dim rat As Double
Dim flgSec
Dim X As Long
Dim WinHeight As Long
Dim hWnd As Long
Dim ret As Long
Dim i As Integer
Dim R As RECT
Dim SizeL As Long
Dim SizeT As Long
Dim SizeW As Long
Dim SizeH As Long
'--------------------------------------------------------------------------------
Public Function FormResiz_OnOpen(parFrm As Form, Optional perSizeL As Long, Optional perSizeT As Long, Optional perSizeW As Long, Optional perSizeH As Long)
On Error Resume Next
Set frm = parFrm
'窗口驾驶盘的取得
hWnd = GetDesktopWindow()
'现在分辨率取得
ret = GetWindowRect(hWnd, R)
'比例计算常例：现在800 开发1024 800/1024 = 0.78加倍
X = (R.x2 - R.x1)
rat = X / DesignSize
SizeL = 0: SizeT = 0: SizeW = 0: SizeH = 0
If Not IsEmpty(perSizeL) = True Then
SizeL = perSizeL * rat
SizeT = perSizeT * rat
SizeW = perSizeW * rat
SizeH = perSizeH * rat
End If
'现在分辨率＝开发分辨率如果终了
If X = DesignSize Then Exit Function
If X < DesignSize Then
'细小策划时、控制＞部分＞表单的次序
Call ChangeCtrl
Call ChengeSec
Call ChangeFrm
Else
'大掬取时、表单＞部分＞控制的次序
Call ChangeFrm
Call ChengeSec
Call ChangeCtrl
End If
'最后、表单的使清新
frm.Refresh
Exit Function
End Function
'--------------------------------------------------------------------------------
Private Sub ChangeCtrl()
On Error Resume Next
'控制转
For Each ctrl In frm.Controls
'*******************************************************************
'选项卡修正，原著没有这段代码，后来有个朋友发现了这个BUG，就是选项卡的位置会偏得很厉害
'所以就加了这段代码来修正
'主要是"Top", "Height","Left","Width"这几个参数的值，根据实际情况适当调整就行了
If ctrl.ControlType = 123 or ctrl.ControlType = 124 Then
For Each prp In ctrl.Properties
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
prp.value = Fix(prp.value * rat + 0.5)
Case "FontWeight"
prp.value = Fix((prp.value * rat) / 100) * 100
Case "Top", "Height"
prp.value = Fix(prp.value * rat * 0.85)
'prp.value = Fix(prp.value * rat)
Case "Left"
prp.value = Fix(prp.value * rat * 0.9)
Case "Width"
prp.value = Fix(prp.value * rat * 0.7)
End Select
Next prp
'********************************************************************************************
Else
'属性转
For Each prp In ctrl.Properties
'大小•配置关于属性被发现们压缩
Select Case prp.Name
Case "FontSize", "DatasheetFontHeight"
'通常计算假如行…情况之下的 +0.5 之类的话不需要是…但…、
'捆Zo~Ma办法。稍微心情坏因为 +0.5
prp.value = Fix(prp.value * rat + 0.5)
Case "FontWeight"
prp.value = Fix((prp.value * rat) / 100) * 100
Case "Left", "Top", "Width", "Height"
prp.value = Fix(prp.value * rat)
End Select
Next prp
End If
Next ctrl
End Sub
'--------------------------------------------------------------------------------
Private Sub ChengeSec()
On Error GoTo Err_Disp
'部分转
flgSec = True
i = 0
'不存在部分的参照错误化验出终了
Do Until flgSec = False
'部分被发现们高度变更
frm.Section(i).Height = Fix(frm.Section(i).Height * rat)
i = i + 1
Loop
Exit Sub
Err_Disp:
If Err = 2462 Then
flgSec = False
Resume Next
Else
MsgBox Err.Description
End If
Resume Next
End Sub
'--------------------------------------------------------------------------------
Private Sub ChangeFrm()
On Error Resume Next
'表单的大小变更
'Optional参数数值渡下次收拾ば、而且使合（计算正在完毕）
If SizeL > 0 Then
DoCmd.MoveSize SizeL, SizeT, SizeW, SizeH
Else
'特别是指定啊假如踢、变更了表单的大小表示
'表单的属性（宽与高度）
frm.Width = Fix(frm.Width * rat)
WinHeight = Fix(frm.WindowHeight * rat)
DoCmd.MoveSize , , frm.Width, WinHeight
End If
End Sub

用VBA赋应用程序图标
见测试窗体
Toolbar 控件使用
本例在一个Toolbar控件中添加五个 Button 对象，并且向每个 Button 对象添加二个 ButtonMenu 对象。单击ButtonMenu对象时，其行为由ButtonMenuClick事件来决定。为了试验本例，在窗体中放置一个 Toolbar 控件，将代码粘贴到代码模块的声明部分。
Option Explicit
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As ComctlLib.ButtonMenu)
   Select Case ButtonMenu.Index
   Case 1
      MsgBox "Press the button."
   Case 2
      MsgBox "Offer some option"
   End Select
End Sub

' 窗体加载事件：
Private Sub Form_Load()
   Dim i As Integer
   Dim btn As Button

   ' 添加五个 Button 对象到 Toolbar 控件。
   For i = 1 To 5
      Set btn = Toolbar1.Buttons.Add(Caption:= i, Style:= tbrDropDown)
      ' 添加两个 ButtonMenu 对象到每一个Button。
         btn.ButtonMenus.Add Text:="Help"
         btn.ButtonMenus.Add Text:="Options"
   Next i
End Sub

Treeview 控件的使用方法
建立一个窗体，在窗体上放置如下控件：
Treeview 控件：名称 Treeview1；
　　Imagelist 控件：名称 Imagelist1，并在该控件中放置三张个性图片（32×32），建立索引1、2、3；（方法：在Imagelist 控件上单击鼠标右键选择属性）
　　Label 控件：名称分别为Lab（0）、Lab（1），Caption分别为“父节点：”、“子节点：”；
　　Textbox 控件：名称分别为Txt（0）、Txt（1），text都为“”；
　　commandbutton 控件：名称为系统默认，Caption分别为“添加”、“展开”、“收起”、“排序”、“删除”、“退出”；
　　将下列代码加入到代码框：
Option Explicit
Dim I As Integer
Dim J As Integer
Dim nodx As Node
Dim CunZai As Boolean '定义变量

Private Sub Command1_Click()
　If Txt(0).Text <> "" And Txt(1).Text <> "" Then '不允许建立零字节的父节点和子节点
　　CunZai = False
　　J = TreeView1.Nodes.Count
　　For I = 1 To TreeView1.Nodes.Count '检查新输入的父节点名称是否存在
　　　If TreeView1.SelectedItem.Children > 0 Then
　　　　If Txt(0).Text = TreeView1.Nodes(I).Text Then CunZai = True
　　　　End If
　　Next I
　　If CunZai = True Then '若存在, 则在父节点下建立子节点
　　　Set nodx = TreeView1.Nodes.Add(Txt(0).Text, tvwChild, "child" & J,
　　　　　　　　　　　　　　 Txt(1).Text, 3)
　　Else ,若不存在,则建立父节点和子节点
　　　Set nodx = TreeView1.Nodes.Add(, , Txt(0).Text, Txt(0).Text, 1)
　　　Set nodx = TreeView1.Nodes.Add(Txt(0).Text, tvwChild, "child" & J,_
　　　　　　　　　　Txt(1).Text, 3)
　　End If
　　TreeView1.Refresh
　ElseIf Txt(0).Text = "" Then MsgBox "请输入父节点名称!", vbInformation, "警告！"
　 '系统提示
　ElseIf Txt(1).Text = "" Then MsgBox "请输入子节点名称!", vbInformation, "警告！"
　End If
End Sub
Private Sub Command2_Click()
　For I = 1 To TreeView1.Nodes.Count
　　TreeView1.Nodes(I).Expanded = True '展开所有节点
　Next I
End Sub
Private Sub Command3_Click()
　For I = 1 To TreeView1.Nodes.Count
　　TreeView1.Nodes(I).Expanded = False '收起所有节点
　Next I
End Sub
Private Sub Command4_Click()
　TreeView1.Sorted = True '排列顺序
End Sub
Private Sub Command5_Click()
　If TreeView1.SelectedItem.Index <> 1 Then
　　TreeView1.Nodes.Remove TreeView1.SelectedItem.Index '删除选定的节点
　End If
End Sub
Private Sub Command6_Click()
　End '退出程序
End Sub
Private Sub Form_Load()
　TreeView1.LineStyle =TvwTreeLines '在兄弟节点和父节点之间显示线
　TreeView1.ImageList = ImageList1 '链接图像列
　TreeView1.Style = tvwTreelinesPlusMinusPictureText
　'树状外观包含全部元素
　Set nodx = TreeView1.Nodes.Add(, , "蒲子明", "蒲子明", 1)
　'建立名称为"蒲子明"的父节点,选择索引为1的图像
　Set nodx = TreeView1.Nodes.Add("蒲子明", tvwChild, "child01", "收件箱", 3)
　'在"蒲子明"父节点下建立"收件箱"子节点,选择索引为3的图像
　Set nodx = TreeView1.Nodes.Add("蒲子明", tvwChild, "child02", "发件箱", 3)
　'在"蒲子明"父节点下建立"发件箱"子节点,选择索引为3的图像
　CunZai = False
End Sub
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
　Node.ExpandedImage = 2 '节点被展开时,选择索引为2的图像
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
　If TreeView1.SelectedItem.Children = 0 Then '检查是否有子节点,0为无
　　For I = 1 To TreeView1.Nodes.Count
　　If TreeView1.Nodes(I).Selected Then
　　　MsgBox "您选择的是：“" & TreeView1.Nodes(I).FullPath & "”子节点！"
　　　 '系统提示
　　End If
　　Next I
　End If
End Sub

TreeView控件示例：
Private Sub Form_Load()
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
Dim nods As Nodes
Dim mnode As Node
Dim nodef As String
Dim hh As String
Set cnn = CurrentProject.Connection
rst.Open "select * from menu order by 菜单号", cnn, adOpenStatic
rst.MoveFirst
Do While Not rst.EOF
nodef = rst!菜单号
If IsNull(rst!上级菜单) Then
Set mnode = TreeView0.Nodes.Add(, , rst!菜单号, rst!菜单名, 1, 2)
Else
nodef = rst!上级菜单
Set mnode = TreeView0.Nodes.Add(nodef, tvwChild, rst!菜单号, rst!菜单名, 3, 4)
End If
rst.MoveNext
Loop
Set rst = Nothing
With TreeView0
.Nodes(1).Expanded = True
End With
End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim varx As Variant
varx = DLookup("[记录]", "menu", "[菜单名]=" & "'" & Node & "'")

Me.记录 = varx

End Sub

如果盘中不存在文件test.dll，则退出数据库
if dir("c:\windows\test.dll")="" then
docmd.quit
end if
使用 Shell 函数来完成一个用户指定的应用程序。
使用 Shell 函数来完成一个用户指定的应用程序。在 MacIntosh 上，默认的驱动名为 “HD” ，路径名称的每部分由冒号而非反斜线分隔。相似地，您可以指定 Macintosh 文件夹而非 \Windows.
' 将第二个参数值设成 1，可让该程序以正常大小的窗口完成，并且拥有焦点。
Dim RetVal
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1) ' 完成Calculator。

Shell("C:\WINDOWS\hh.exe c:\a.chm", vbNormalFocus)
hh.exe 是打开chm的程序文件。
chm是帮助文件
对外部文件管理
Set fs = CreateObject("Scripting.FileSystemObject") '设置系统计算机的驱动器、文件夹和文件记录集
fs.CopyFile "c:\12345.txt", "c:\abcde.txt" '拷贝文件
或：filecopy c:\a.mdb,d:\b.mdb

fs.DeleteFile "c:\12345.txt" '删除刚拷贝的文本文件
打开外部数据库
Private Sub Command5_Click()
Dim aobject As String
'定义对象变量
Set aobject = openobject("e:\学生规范考查.mdb", True, False)
'打开名为学生规范考查.mdb的库
End Sub

提示用户插入软盘
如果驱动器中没有软盘则会出现错误，
程序应提供没有软盘的信息：
Sub InsertDisk()
On Error Resume Next
If IsError(MyFile=Dir(“a:”,vbVolume))=True Then
MsgBox “驱动器中没有软盘，请插入软盘！”
Exit Sub
End If
End Sub
向表中加新字段
CurrentDb.Execute "Alter Table 表名 Add Column 新字段名 Char(13)"

自定义函数 IsYlwjcct("窗体名") （如果指定的窗体打开，返回True）
Function IsYlwjcct(ByVal strFormName As String) As Boolean
    Const conObjStateClosed = 0
    Const conDesignView = 0
    If SysCmd(acSysCmdGetObjectState,acForm,strFormName) <>conObjStateClosed Then
        If Forms(strFormName).CurrentView<>conDesignView Then
            IsYlwjcct=True
        End If
    End If
End Function

删除当前数据库的表的字段
CurrentDb.Execute "Alter Table 名表 Drop Column字段名"
使主程序窗口的X失效
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Private Sub FORM_Load()

Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060

    Dim hMenu As Long

    hMenu = GetSystemMenu(Application.hWndAccessApp, 0)

    Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)

End Sub
打开模块
    DoCmd.OpenModule "设置启用禁用shift", ""
隐藏当前活动窗体
me.Form.Visible=True
隐藏主窗口
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3

' 使用举例
' 最大化 Access 窗口
'       ?fSetAccessWindow(SW_SHOWMAXIMIZED)
' 最小化 Access 窗口
'       ?fSetAccessWindow(SW_SHOWMINIMIZED)
' 隐藏 Access 窗口
'       ?fSetAccessWindow(SW_HIDE)
' 正常显示 Access 窗口
'       ?fSetAccessWindow(SW_SHOWNORMAL)
'
Option Compare Database

Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Function fSetAccessWindow(nCmdShow As Long)

Dim loX As Long
Dim loForm As Form
    On Error Resume Next
    loX = apiShowWindow(hWndAccessApp, nCmdShow)
    Err.Clear
    fSetAccessWindow = (loX <> 0)
End Function

Private Sub Form_Load()
Dim yhsfm As String
yhsfm = CurrentUser()

If yhsfm <> "ylw" Then
Dim X
X = fSetAccessWindow(0)

End If
End sub

在一个窗体中执行另一窗体的子程序
DoCmd.OpenForm "窗体2"
Call Forms("窗体2").aaa
禁用主窗口最大化和最小化按钮
'声明
Private Declare Function GetSystemMenu Lib "user32.dll" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32.dll" _
(ByVal hMenu As Long, ByVal uPosition As Long, ByVal uFlags As Long) As Long

'使用
Private Sub Form_Load()
Dim hSysMenu As Long
Dim retval As Long
hSysMenu = GetSystemMenu(hWndAccessApp, 0)
retval = RemoveMenu(hSysMenu, &HF120, &H0)
hSysMenu = GetSystemMenu(Me.hwnd, 0)
retval = RemoveMenu(hSysMenu, &HF120, &H0)
End Sub

让主窗口最大化和最小化按钮消失
'声明：
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)

'使用：
Private Sub Form_Load()
Dim lWnd As Long
lWnd = GetWindowLong(hWndAccessApp, GWL_STYLE)
lWnd = lWnd And Not (WS_MINIMIZEBOX)
lWnd = lWnd And Not (WS_MAXIMIZEBOX)
lWnd = SetWindowLong(hWndAccessApp, GWL_STYLE, lWnd)
End Sub
计时器触发
Me.Text4.Value = Now()
隐藏当前激活的工具条：

Dim dqgjt As Variant
Set dqgjt = CommandBars.ActiveMenuBar
dqgjt.Enabled = False

显示和隐藏自定义的工具条
DoCmd.ShowToolbar "你的工具条名称", acToolbarYes

DoCmd.ShowToolbar "你的工具条名称", acToolbarNo

隐藏主程序窗口：(详见示例库)
Option Compare Database
Option Explicit
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long

Private Sub Command0_Click()
    If Me.Command0.Caption = "隐藏窗体" Then
        Me.Command0.Caption = "显示窗体"
        Call apiShowWindow(hWndAccessApp, SW_HIDE)
        DoCmd.Restore
    Else
        Me.Command0.Caption = "隐藏窗体"
        Call apiShowWindow(hWndAccessApp, SW_SHOWNORMAL)

        DoCmd.Close acForm, "frm_main"
        DoCmd.ShowToolbar "菜单栏", acToolbarYes
        DoCmd.Restore
    End If
End Sub

主窗口最小化：
DoCmd.RunCommand acCmdAppMinimize

用代码打开窗体中选项卡控件的某页
Me.选项卡控件名.Pages(n).SetFocus
其中n是要打开的页号（页号是从0开始的）
对不同视图中对象的标题进行设置
使用 Caption 属性可以对不同视图中对象的标题进行设置，为用户提供有用的信息：

字段标题用于指定通过从字段列表中拖动字段而创建的控件所附标签上的文本，并作为表或查询“数据表”视图中字段的列标题。
窗体标题用于指定在“窗体”视图中标题栏上显示的文本。
报表标题用于指定在“打印预览”中报表的标题。
按钮和标签标题用于指定在控件中显示的文本。
String 型，可读写。

expression.Caption

expression 必需。返回“Applies To”列表中的一个对象的表达式。
怎样使用一个查询获得数据库对象的名称(查询/窗体/表/报表/模块/宏)?
查询:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)=5 orDER BY MSysObjects.Name;

窗体:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)=-32768 orDER BY MSysObjects.Name;

表:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (Left$([Name],4) <> "Msys") AND (MSysObjects.Type)=1 orDER BY MSysObjects.Name;

报表:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32764 orDER BY MSysObjects.Name;

模块:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32761 orDER BY MSysObjects.Name;

宏:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32766 orDER BY MSysObjects.Name;

文件被创建或最后修改后的日期和时间FileDateTime 函数
返回一个 Variant (Date)，此为一个文件被创建或最后修改后的日期和时间。
语法
FileDateTime(pathname)
必要的 pathname 参数是用来指定一个文件名的字符串表达式。pathname 可以包含目录或文件夹、以及驱动器。
●适用于VB、VBA。
●用法：传回值 = FileDateTime("c:\windows\文件名.com")

让ACCESS程序发出声音的函数
Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
(ByVal filename As String, ByVal snd_async As Long) As Long

Function PlaySound(sWavFile As String)
' Purpose: Plays a sound.
' Argument: the full path and file name.

If apisndPlaySound(sWavFile, 1) = 0 Then
MsgBox "The Sound Did Not Play!"
End If
End Function

调用方法：PlaySound "文件名.WAV"

检测表中有无记录
tblAAAA,其中有一字段MMM
if isnull(dlookup("[MMM]","tblAAAA")) then
msgbox "此表无记录"
end if
使用表达式使一个文本框自动分为几段,并按文本格式首行左空2字!
加上chr()码，chr(32)是空格，10 和 13 分别为换行和回车字符。
身份证号输入的检查（焦点移到下一控件时）
Private Sub 下一控件名称_GotFocus()
If Len(Me.文本框) <> 15 And Len(Me.文本框) <> 18 Then
   MsgBox "1111"
   Me.文本框.SetFocus
End If
End Sub
如何使鼠标停留在组合框上时，使组合框自动打开
Private Sub 文本框_GotFocus()
Me![文本框].Dropdown
End Sub
组合框里面有20行数据，现在需要双击组合框，组合框内数据会依次显示
Private Sub Combo0_DblClick(Cancel As Integer)
If Combo0.ListCount < 1 Then Exit Sub

Dim I As Long
I = Combo0.ListCount
If Combo0.ListIndex < I - 1 Then
   Combo0.ListIndex = Combo0.ListIndex + 1
Else
   Combo0.ListIndex = 0
End If

End Sub

在VB中改变控件的类型
Private Sub cmdPerformMorph_Click()
   DoCmd.Echo False, "Morphing controls, please wait..."
   DoCmd.SelectObject acForm, "ControlMorphExampleForm2"
   DoCmd.DoMenuItem acFormBar, 2, 0
   If Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acListBox Then      Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acComboBox
   Else      Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acListBox
   End If
   If Forms!ControlMorphExampleForm2!optMorphing.ControlType = acOptionButton Then
      Forms!ControlMorphExampleForm2!optMorphing.ControlType = acCheckBox
   Else
      Forms!ControlMorphExampleForm2!optMorphing.ControlType = acOptionButton
   End If
   DoCmd.DoMenuItem acFormBar, 2, 1
   DoCmd.SelectObject acForm, "ControlMorphExampleForm1"
   DoCmd.Echo True
End Sub
数字货币转换为大写格式
以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = convertNum(inputValue)
^                        ^
须显示                  填写小
大写的                  写的控
控件                    件名

-------------------------------------------
Function GetChoice1(ByVal ind As Integer)
GetChoice1 = Choose(ind + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
End Function
Function GetChoice2(ByVal ind As Integer) '注意"byval",按值传递
Dim tempInt As Integer
ind = ind - 1
tempInt = ind \ 4 '取商
ind = ind Mod 4 '取余
GetChoice2 = IIf(ind > 0, Choose(ind, "拾", "佰", "仟", "万"), Choose(IIf(tempInt > 2, 1, tempInt), "万", "亿"))
End Function
'--------------------------------------------
'主函数convertNum
Function ConvertNum(Baval Num As Variant) As String
Dim i As Integer, j As Integer
Dim tempInt As Integer
Dim tempStr, ResultStr As String
tempStr = CStr(Num) '转换成字符型
j = Len(tempStr) '取得长度
For i = 1 To j '对每个数字进行大写转换
tempInt = CInt(Mid(tempStr, j - i + 1, 1)) '
ResultStr = GetChoice1(tempInt) & GetChoice2(i) & ResultStr
Next i
ConvertNum = ResultStr

以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = chMoney(Val(inputValue))
^                        ^
须显示                  填写小
大写的                  写的控
控件                    件名

' 名称： CCh
'        得到一位数字 N1 的汉字大写
'        0 返回 ""
Public 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
Dim st1, t1

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
如何加入换行符
C="A" + vbNewLine + "B"
[联系电话] = "1111" + Chr(13) + Chr(10) + "2222"
给一绑定文本框赋值，可以成功的看到换行效果：
1111
2222

在多页窗体中用按钮翻页
上一页
Private Sub 上一页_Click()
DoCmd.GoToPage 1
End Sub

下一页
Private Sub 下一页_Click()
DoCmd.GoToPage 2
End Sub
关闭指定窗体并按参数打开报表或窗体
Private Sub 打印各班名册_Click()
On Error GoTo 打印各班名册_Click_Err

DoCmd.Close acForm, "学籍管理库"
''指定报表或窗体名称，并指定基础表的字段的参数
DoCmd.OpenReport "同江市第三小学在校生名册", acPreview, "", "[在籍学生基本情况表]![年班]=[请输入年班（如：一年二班）]"
打印各班名册_Click_Exit:
Exit Sub

打印各班名册_Click_Err:
MsgBox Error$
Resume 打印各班名册_Click_Exit

End Sub
在窗体中按基础表的参数筛选
Private Sub 按班筛选_Click()
On Error GoTo 按班筛选_Click_Err
''在窗体中按基础表的参数筛选
    DoCmd.ApplyFilter "", "[在籍学生基本情况表]![年班]=[请输入年级和班级（如：一年二班）]"
按班筛选_Click_Exit:
    Exit Sub
按班筛选_Click_Err:
    MsgBox Error$
    Resume 按班筛选_Click_Exit
End Sub
取消所有筛选
Private Sub 取消所有筛选_Click()
DoCmd.ShowAllRecords
End Sub

使用 For...Next 语句
可以使用 For...Next 语句去重复一个语句块，而它的次数的数字是指定的。For 循环使用一个计数变量，当重复每个循环时它的值会增加或减少。
下面的过程会让计算机发出哔声 50 次。For 语句会指定计数变量 x 的开始与结束值。Next 语句会将计数变量的值加 1。
Sub Beeps()
    For x = 1 To 50
        Beep
    Next x
End Sub
使用 Step 关键字，可以由所指定的值增加或减少计数变量。在下面的示例中，计数变量 j 会在每次循环重复时加上 2。当循环完成时，total 的值为 2、4、6、8 和 10 的总合。
Sub TwosTotal()
    For j = 2 To 10 Step 2
        total = total + j
    Next j
    MsgBox "The total is " & total
End Sub
为了减少计数变量的值，可以使用负的 Step 值。为了减少计数变量的值，必须指定一个小于开始值的结束值。在下面的示例中，计数变量 myNum 会在每次循环重复时减去 2。当循环完成时，total 的值为 16、14、12、10、8、6、4 和 2 的总合。
Sub NewTotal()
    For myNum = 16 To 2 Step -2
        total = total + myNum
    Next myNum
    MsgBox "The total is " & total
End Sub
注意在 Next 语句后面不必包含计数变量的名称。上述的示例中，因为要具有可读性才加上计数变量的名称。
可以在计数变量到达它的结束值之前，使用 Exit For 语句来退出 For...Next 语句。例如，当错误发生时，可以使用在 If...Then...Else 语句或是 Select Case 语句的 True 语句块中的 Exit For 语句，它是专门用来检查此错误的。如果没有错误发生，则 If...Then...Else 语句的值为 False，循环会象预期那样的运行。

如何用sql取得服務器的系統時間
用getdate()可以得到系统的当前时间
例子：
public function getsqlsvrtime() as datetime
    dim rst as adodb.recordset

    set rst = new adodb.recordset
    set rst.activeconnection = currentproject.connection
    rst.open "select getdate() as svrtime"

    getsqlsvrtime = rst.fields("svrtime")
end function
函数 getsqlsvrtime 返回 sql server 服务器上的当前日期和时间。
如果取时间：
dim stime as string
stime = format(getsqlsvrtime(), "short time")     ' 短时间
如果取日期：
dim sdate as string
sdate = format(getsqlsvrtime(), "long date")      ' 长日期

利用IIF函数根据学号（如：19975012）显示年班
注意学号的编排要根据入学年份和班号及个人号，如：19975012表示“1997年入学，5班，012号”。下面的查询示例中的学号为8位数，学号“19975012”在系统时间为2002年8月份与2003年7月份之间会显示出“6年5班”；在系统时间为2003年8月份之后会显示出“2003年毕业于5班”

=IIf(Month(Date())>7,IIf(Year(Date())-Left([学号],4)>5,Left([学号],4)+6 & "年" & "毕业" & "于" & Mid([学号],5,1) & "班",Year(Date())-Left([学号],4)+1 & "年" & Mid([学号],5,1) & "班"),IIf(Year(Date())-Left([学号],4)>6,Left([学号],4)+6 & "年" & "毕业" & "于" & Mid([学号],5,1) & "班",Year(Date())-Left([学号],4) & "年" & Mid([学号],5,1) & "班"))
利用Choose函数在查询中生成[年班]字段
年班: IIf(Month(Date())>7,Choose(Year(Date())-Left([学生名册]![学号],4)+1,"一年","二年","三年","四年","五年","六年"),Choose(Year(Date())-Left([学生名册]![学号],4),"一年","二年","三年","四年","五年","六年")) & Choose(Mid([学生名册]![学号],5,1),"一班","二班","三班","四班","五班")
利用IIF函数在查询中生成[年班]字段
字段表达式为：
年班: IIf(Month(Date())>7,IIf(Year(Date())-Left([学生基本情况]![学生编号],4)>5,"",Year(Date())-Left([学生基本情况]![学生编号],4)+1 & "年" & Mid([学生基本情况]![学生编号],5,1) & "班"),IIf(Year(Date())-Left([学生基本情况]![学生编号],4)>6,"",Year(Date())-Left([学生基本情况]![学生编号],4) & "年" & Mid([学生基本情况]![学生编号],5,1) & "班"))
准则表达式为：
<>""

按以下步骤打包的数据库已在 PWin98OEM2 & IE5.0 & AccessRuntime2002 的环境中成功运行。

    真正能够让使用 Access 编写的数据库独立运行的就是 Microsoft Office Access（专门有此版本的 Access）。现在大家一直需要的 Office 开发版其实不只包括 Access 的打包软件，而大家目前用到、谈到的就像是 Office 开发版 = Office 打包软件似的，这是错误的观点。
    下面详细叙述一下关于在使用 Access 打包软件时必须注意的问题：
    首先：Access 打包软件并不能将您自己编写的 Access 数据库(*.mdb或者*.mde)转换成单独可以运行的一个可执行文件(*.exe)。
    其次：Access 开发版中的打包软件只是其中的一个组件而已。
    再次：Access 开发版的打包软件的打包过程如下：
    1、它会根据你的要求生成3种不同大小的 Access Runtime版本
    ① 只包括AccessRuntime
    ② 包括 AccessRuntime 和 Windows 安装服务程序以及其他数据库访问组件还有IE4.1
    ③ 包括上述所有内容再加上IE5.1
    2、压缩并打包你的数据库(*.mdb,*.mde...)以及你的数据库运行所需的文件，也就是Access中没有的文件，比如你自己用的背景、附件等等。
    最后：所以你如果真的需要将你自己的数据库打包发布，完全没有必要使用难以得到的 Access 开发版，你只需要得到 Access的运行时版本和将你自己的mdb文件压缩打包就可以了。也就是说，AccessRuntime 本身在 Office的安装光盘里面就有，而压缩打包的软件也是到处都有，比如我就推荐 WinRAR3.0。
    所以，我得出的结论是：如果你想得到 Access 的开发版，而其用途只是为了使用其中的打包工具，那么你根本没有必要去苦苦寻觅，在你身边的软件就已经能够完成上述的工作了。
    有关 Access Runtime 软件的具体位置：Access Runtime 2002 的安装文件在 OfficeXP 光盘的如下位置：光盘盘符:\FILES\MOD\ACCESSRT.MSI
    在新的机器上安装 Access Runtime 2002 后仍然无法正常打开编写好的数据库，这主要是因为他们还没有安装数据库访问组件，该组件共 19 个文件 25.5MB。安装时会提示缺少 IE5 。我想也不用我提示了吧？直接用 IE5 代替即可，就是建立如下目录：
    比如：OSP.MSI 在 c:\AccessRuntime2002\OSP.MSI 的位置，就请你自行将 IE5 的所有文件拷贝至 c:\AccessRuntime2002\IE5\SC 下面就可以正常安装了。
硬盘id号SerialNumber 属性
一：
Dim fs, d, v
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("c:\")))
v = Hex(d.SerialNumber)
msgbox "c 硬盘序列号(16制): " & v

二：
Sub ShowDriveInfo(drvpath)
Dim fs, d, s, t
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
s = "Drive " & d.DriveLetter & ": - " & t
s = s & vbCrLf & "SN: " & d.SerialNumber
MsgBox s
End Sub

自定义获取CPU_ID函数
Public Function wmiProcessorID()
Dim CPUID As String
Dim CPUSet
Dim CPU
Set CPUSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
InstancesOf("Win32_Processor")
For Each CPU In CPUSet
CPUID = CPUID & CPU.ProcessorId
Next
wmiProcessorID = CPUID
End Function

硬盘序列号
一：将HDSerialNumRead.dll拷到系统盘的windows下，再建立如下模块：
Private Declare Function HDSerialNumRead Lib "HDSerialNumRead.dll" () As String

Public Function GetHDSerialNum() As String
    Dim S As String
    S = Trim(HDSerialNumRead())
    GetHDSerialNum = Left(S, Len(S) - 1)
End Function
二：在窗体的事件上写代码：
Me.文本框 = GetHDSerialNum()

在Access中获取本机IP地址、电脑名及开机登录用户名
来源：tehthspace.accxp.com

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type

Declare Function wu_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function wu_GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Function ap_GetComputerName() As Variant
Dim strComputerName As String
Dim lngLength As Long
Dim lngResult As Long

strComputerName = String(255, 0)
lngLength = 255

lngResult = wu_GetComputerName(strComputerName, lngLength)
ap_GetComputerName = Left(strComputerName, InStr(1, strComputerName, Chr(0)) - 1)

End Function

Function ap_GetUserName() As Variant
Dim strUserName As String
Dim lngLength As Long
Dim lngResult As Long

strUserName = String(255, 0)
lngLength = 255

lngResult = wu_GetUserName(strUserName, lngLength)
ap_GetUserName = Left(strUserName, InStr(1, strUserName, Chr(0)) - 1)

End Function
Function GetComputerIP() As String
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim I As Integer
Dim vntTemp As Variant

SocketsInitialize

hostent_addr = gethostbyname(vntTemp)

If hostent_addr = 0 Then
MsgBox "Can't resolve name."
Exit Function
End If

RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4

ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength

For I = 1 To host.hLength
GetComputerIP = GetComputerIP & temp_ip_address(I) & "."
Next
GetComputerIP = Mid$(GetComputerIP, 1, Len(GetComputerIP) - 1)

SocketsCleanup
End Function

Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function

Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function

Sub SocketsInitialize()

Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String

iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

If iReturn <> 0 Then
MsgBox "Winsock.dll is not responding."
End
End If

If lobyte(WSAD.wversion) < WS_VERSION_MAJOR or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
MsgBox sMsg
End
End If

If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox sMsg
End
End If

End Sub

Sub SocketsCleanup()
Dim lReturn As Long

lReturn = WSACleanup()

If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If

End Sub
WinAPI 如何取得磁碟序號 0001 　
取得Disk Volume序號
模組
Private Declare Function GetVolumeInformation Lib _
"kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Function GetDiskSerialNumber(strDrive As String) As String
Dim SerialNum As Long
GetVolumeInformation strDrive, vbNullString, _
0, SerialNum, 0, 0, vbNullString, 0
GetDiskSerialNumber = Hex(SerialNum)
End Function

‘若要取得C碟的序號只要呼叫
Private Sub Command0_Click()
   Dim serNum As String
   serNum = GetDiskSerialNumber("C:\")
   MsgBox serNum, 64, "WinAPI : 001"
End Sub
提升前后台模式程序的速度
Dim cn As Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Set cn = CurrentProject.Connection
sql = "select * from 1"
rs.Open sql, cn, 3, 3, 1
你的软件最好有个主控面板，一打开软件它就打开，关闭软件它才关闭。在后台数据库文件里建一个只有一个字段的空表，名为1（其它名也可以），然后把上面的代码放在主控面板的OPEN事件里。
这里面用到的小技巧就是：打开了一个空表，但没关闭它，这样后台数据库就一直在打开状态（你可以看到后台数据库会生成一个LDB文件），你要操作其它表的时候就不用频繁地打开、关闭后台数据库，这样程序运行起来可以提升级几倍的速度，试试看吧。
另：最好是100M的局域网。不过我在10M的网上也用得很爽，现在是5个用户同时用都没感觉到慢。

时间延迟问题
想在运行第一行代码后若干时间后（如1分钟）
再执行第二行代码——
怎么办？？？
我的方法
--------------------------------------------------------------------------------
设一公共变量NumTime
在Form_Timer过程里加一语句：NumTime=NumTime+1
然后在第一行代码及第二行代码之间插入以下语句
me.TimerInterval = 1000
do while numtime< = 60
DoEvents
loop
me.TimerInterval = 0
--------------------------------------------------------------------------------

zhengjialon的方法
-------------------------------------------------------------------------------

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub AsyncThread()
'让这个线程停止十秒。
Sleep 10000
MsgBox dd
End Sub

获取windows安装路径
在Access中用这个函数：
Environ("windir")
可得出windows的安装路径
用api就麻烦一点：
在模块里声明API函数：
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
然后在任一过程写以下语句：
Dim s As String * 80
Dim Length As Long
Dim WinPath As String
Dim SysPath As String
Length = GetWindowsDirectory(s, Len(s))
WinPath = Left(s, Length)
Length = GetSystemDirectory(s, Len(s))
SysPath = Left(s, Length)
MsgBox "Windows安装路径是：" & WinPath
MsgBox "system路径是：" & SysPath
获取指定表所有字段名的函数
Private Function GETZD(tbName As String)
    Dim cat As New ADOX.Catalog
    cat.ActiveConnection = CurrentProject.Connection
    For i = 0 To cat.Tables(tbName).Columns.Count - 1
        Debug.Print cat.Tables(tbName).Columns.Item(i).Name
    Next
End Function
'需引用ADOX
'用法：GETZD ("表名")

如何用vba检查软驱是否有软盘
Private Sub 命令0_Click()
Dim Flag As Boolean
Flag = Fun_FloppyDrive("A:")
If Flag = False Then MsgBox "A:驱没有准备好，请将磁盘插入驱动器！", vbCritical
End Sub
Private Function Fun_FloppyDrive(sDrive As String) As Boolean
'-------------------------------
'函数:检查软驱中是否有盘的存在
'-------------------------------
On Error Resume Next
Fun_FloppyDrive = Dir(sDrive) <> ""
End Function
打开、关闭“计算器”
1．如何控制设计？
新建一表单，在表单中放入两个按钮，其Caption分别为“打开”（即启动“计算器”）和“关闭”（退出结束），且为它们分别添加Click事件处理。详见表单Form1及单元文件Unit1。
其中，最主要的几条语句有：
fwnd:=FindWindow('SciCalc','计算器');
函数原型为（详见Delphi的帮助）:
HWND FindWindow(
LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
此处，'SciCalc' 为计算器的类名，'计算器'为计算器的窗口标题}
setWindowPos(fwnd,HWND_NOTOPMOST,0,0,0,0,SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
函数原型为:
BOOL SetWindowPos(
HWND hWnd, // handle of window
HWND hWndInsertAfter, // placement-order handle
int X, // horizontal position
int Y, // vertical position
int cx, // width
int cy, // height
UINT uFlags // window-positioning flags
);
ShowWindow(fwnd,SW_RESTORE); //显示已打开的「计算器」
函数原型为:
BOOL ShowWindow(
HWND hWnd, // handle of window
int nCmdShow // show state of window
);
Ret:=WinExec('c:\windows\calc.exe',SW_SHOWNORMAL); //启动计算器
函数原型为:
UINT WinExec(
LPCSTR lpCmdLine, // address of command line
UINT uCmdShow // window style for new application
);
运行“计算器”程序并检测返回值（从而利用返回值来判断可能发生的错误）

2．如何明确应用程序的“类名”？
要控制应用程序，首先必须明确应用程序的“类名”。“类”的概念，Delphi的程序已经非常清楚，如：新建一表单Form1，该表单的“类名”为TForm1。那么其它Windows程序的“类名”如何确定呢？
值得一喜的是，Delphi提供了一实用工具Winsight，它正如一面照妖镜，不论何方妖怪，均会显露出它们的“类名”。
使用Winsight的方法如下：
　⑴运行Winsight（程序名为ws32.exe，与主文件delphi32.exe同一目录），见图①；
　⑵从Winsight的菜单中选择“间谍”中的“跟随焦点”，见图②；
　⑶运行“计算器”程序；
　⑷在Winsight中显示出了目标，如图③所示。
软件环境：中文Win98/中文Delphi5.0。
打开（工具－选项）
一、DoCmd.DoMenuItem acFormBar, 6, 11, , acMenuVer70
二、docmd.RunCommand.accmdoption
1、如何让窗体总在最前面？
*API函数声明
Declare Function SetWindowPos Lib "user32" ( ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
注释：常量声明
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
注释：在某个form里写：
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE 注释：或下面
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE
2、使用API函数sendmessage，获得光标所在行和列。
Sub getcaretpos(byval 　TextHwnd&,LineNo&,ColNo&)
　注释：TextHwnd为TextBox的hWnd属性值，　　LineNo为所在行数，ColNo为列数
　　dim I&,j&,k& 注释：获取起始位置到光标所在位置字节数　　　　　　　　　I=SendMessage(TextHwnd,&HB0&,0,0) j=I/2^16 注释：确定所在行　　　　　　LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1
　　注释：确定所在列
　　k=SendMessage(TextHwnd,&HBB&,-1,0)
　　ColNo=j-k+1
End sub
3、如何以某种颜色填充某区域？
*API函数声明
Private Declare Sub FloodFill Lib "gdi32" _ (ByVal Hdc As Long, ByVal X As Long, ByVal Y As _ Long, ByVal crColor As Long
注释：设(fillx,filly)为此区域内任一点
注释：Color为某种颜色
FloodFill Picture1.Hdc, fillx, filly,Color
4、如何关闭计算机？
*API函数声明
Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long, ByVal wReserved As Integer) As Integer
注释：执行
Dim DUMMY
DUMMY=ExitWindows(0，0)
5、如何获取Windows目录和System目录？
注释：复制以下代码到一模块中
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
注释：在程序中调用
Dim WindowsDirectory As String, SystemDirectory As String, x As Long
WindowsDirectory = Space(255)
SystemDirectory = Space(255)
x = GetWindowsDirectory(WindowsDirectory, 255)
x = GetSystemDirectory(SystemDirectory, 255)
MsgBox "Windows的安装目录是:" + WindowsDirectory+",系统目录是:" + SystemDirectory
6、如何建立简单的超级连接？
*API函数声明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecute A" (ByVal hWnd As Long, 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, "open", " http://tyvb.126.com";, vbNullString, vbNullString, 3
注释：给某个信箱发电子邮件
ShellExecute hwnd, "open", "mailto:sst95@21cn.com", vbNullString, vbNullString, 0
7、如何得知TextBox中文字所有的行数？
*API函数声明
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const EM_GETLINECOUNT = &HBA
注释：在程序中调用
LineCnt = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, 0)
注释：LineCnt即为此TextBox的行数。
8、如何设置ListBox的水平卷动轴的宽度？
*API函数声明
Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long
注释：调用
Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)
注释：注意400是以象素为单位，你可以根据情况自行设定。
9、如何交换鼠标按键？
*API函数声明
Declare Function SwapMouseButton& Lib "user32" _ (ByVal bSwap as long)
要交换鼠标按键，将bSwap参数设置为True。要恢复正常设置，将bSwap设置为False。然后调用函数就可以交换和恢复鼠标按键了。
10、如何让窗体的标题条闪烁以引起用户注意？
在窗体中放一个Timer控件Timer1,设置其Inteval=200
*API函数声明
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
注释：在窗体中写下如下代码:
Private Sub Timer1_Timer()
　FlashWindow Me.hwnd, True
End Sub
11、怎样找到鼠标指针的XY坐标？
*API函数声明
Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
调用：
GetCursorPos z
print z.x
print z.y
12、怎样获得和改变双击鼠标的时间间隔？
获得鼠标双击间隔时间：
Public Declare Function GetDoubleClickTime Lib "user32" Alias _ "GetDoubleClickTime" () As Long
获得鼠标双击间隔时间：
Declare Function SetDoubleClickTime Lib "user32" Alias "SetDoubleClickTime" (ByVal wCount As Long) As Long
注释：注意：这种改变将影响到整个操作系统
以上两个函数都可精确到毫秒级。
13、在程序中如何打开和关闭光驱门？
*API函数声明如下:
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
注释：调用时的代码如下
Dim Ret As Long
Dim RetStr As String
注释：打开光驱门
Ret = mciSendString("set CDAudio door open", RetStr, 0, 0)
注释：关闭光驱门
Ret = mciSendString("set CDAudio door closed", RetStr, 0, 0)
14、如何获得Windows启动方式?
在Form1中加入一个CommandButton、一个Label并加入如下代码:
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CLEANBOOT = 67
Private Sub Command1_Click()
　Select Case GetSystemMetrics(SM_CLEANBOOT)
　Case 1
　　Label1 = "安全模式."
　Case 2
　　Label1 = "支持网络的安全模式."
　Case Else
　　Label1 = "Windows运行在普通模式."
　End Select
End Sub
15、怎样使Ctrl-Alt-Delete无效？
*API函数声明
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
编写如下函数：
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
使Ctrl-Alt-Delete无效：
Call DisableCtrlAltDelete(True)
恢复Ctrl-Alt-Delete ：
Call DisableCtrlAltDelete(False)
16、如何移动没有标题栏的窗口？
我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：
*API函数声明：
Declare Function ReleaseCapture Lib "user32" () As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
在 Form_MouseDown 事件中：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0&
End Sub
17、VB中如何使用延时函数？
*API函数声明：
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
调用：
注释：延时1秒
Call Sleep(1000)
18、调用修改屏幕保护口令的窗口：
Private Declare Function PwdChangePassword Lib "mpr" Alias "PwdChangePasswordA" (ByVal lpcRegkeyname As String, ByVal hwnd As Long, ByVal uiReserved1 As Long, ByVal uiReserved2 As Long) As Long
调用：
Call PwdChangePassword("SCRSAVE", Me.hwnd, 0, 0)
19、使Windows开始屏幕保护：
*API函数声明
Private Declare Function SendMessage Lib "user32"
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg
As Long, ByVal wParam As Long, ByVal lParam As Long)
As Long
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
注释：调用
Dim result As Long
result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
20、如何改变Windows桌面背景？
*API函数声明
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UpdateINIFILE = &H1
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
注释：调用
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:windowsClouds.bmp", SPIF_UpdateINIFILE)
21、怎样确定系统是否安装了声卡？
*API函数声明：
Declare Function waveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
代码如下：
Dim I As Integer
I = waveOutGetNumDevs()
If I > 0 Then MsgBox "你的系统可以播放声音。", vbInformation, "声卡检测"
Else
MsgBox "你的系统不能播放声音。", vbInformation, "声卡检测"
End If
22、如何找到CD-ROM驱动器的盘号？
下面的函数将检查你计算机所有的驱动器看是否是 CD-ROM，如果是就返回驱动器号，如果没有就返回空字符
Public Function GetCDROMDrive() As String
　Dim lType As Long,I As Integer,tmpDrive as String,found as Boolean
　On Error GoTo errL
　For I = 0 To 25
　　tmpDrive = Chr(65 + I) & ":"
　　lType = GetDriveType(tmpDrive) 注释：Win32 API 函数
　　If (lType = DRIVE_CDROM) Then 注释：Win32 API 常数
　　　found = True
　　　Exit For
　　End If
　Next
　If Not found Then tmpDrive = ""
　BI_GetCDROMDrive = tmpDrive
　exit Function
　errL: msgbox error$
End Function
23、如何将文件放入回收站？
**API函数声明
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_Delete = &H3
Public Const FOF_ALLOWUNDO = &H40
注释：调用
Dim Shop As SHFILEOPSTRUCT, strFile as string
With Shop
.wFunc = FO_Delete
.pFrom = strFile + Chr(0)
.fFlags = FOF_ALLOWUNDO
End With
24、VB中如何使用未安装的字体？
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
增加字体：
Dim lResult As Long
lResult = AddFontResource("c:myAppmyFont.ttf")
删除字体：
Dim lResult As Long
lResult = RemoveFontResource("c:myAppmyFont.ttf")
25、如何得知键盘number lock等开关键的状态？
Declare Function GetKeyState Lib "User32" (ByVal lngVirtKey As Long) As Integer
GetKeyState(vbKeyNumLock)
GetKeyState(vbKeyCapital)

页码表达式的示例
下面列出了可以在窗体或报表的“设计”视图中使用的页码表达式示例以及在其他视图中可以看到的结果。
• 表达式：=[Page]
结果：1, 2, 3
• 表达式：="Page " & [Page]
结果：Page 1, Page 2, Page 3
• 表达式：="Page " & [Page] & " of " & [Pages]
结果：Page 1 of 3, Page 2 of 3, Page 3 of 3
• 表达式：=[Page] & " of " & [Pages] & " Pages"
结果：1 of 3 Pages, 2 of 3 Pages, 3 of 3 Pages
• 表达式：=[Page] & "/"& [Pages] & " Pages"
结果：1/3 Pages, 2/3 Pages, 3/3 Pages
• 表达式：=[Country] & " - " & [Page]
结果：UK - 1, UK - 2, UK - 3
• 表达式：=Format([Page], "000")
结果：001, 002, 003

如何提高拆分数据库在网上运行、编辑的速度！！　
Dim cn As Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Set cn = CurrentProject.Connection
sql = "select * from 1"
rs.Open sql, cn, 3, 3, 1
你的软件最好有个主控面板，一打开软件它就打开，关闭软件它才关闭。在后台数据库文件里建一个只有一个字段的空表，名为1（其它名也可以），然后把上面的代码放在主控面板的OPEN事件里。
图像作窗体背景，让图像大小和窗体的大小保持一致。
在FORM_load 和FORM_resize 里加上　
图片.width=me.windowwidth
图片.height=me.windowheight
来源：爱赛思应用网。
让用户不能随意退出(退出前提示)！
建立一个窗体，名字叫隐藏，并在启动选项内选定这个窗体为启动时自动打开。
然后在窗体的加载事件内加入如下代码：
Private Sub Form_Load()
Me.Visible = False
End Sub
''在窗体的卸载事件中加入如下代码：
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("你真的要退出吗？", vbYesNo + vbQuestion, "请确认…") = vbNo Then Cancel = True
End Sub

VB启动控制面板大全
模块： control.exe
命令： rundll32.exe shell32.dll,Control_RunDLL
结果：显示控制面板窗口。
例子：
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL")
辅助选项
模块： access.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5
结果：显示辅助选项/常规。
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1
结果：显示辅助选项/键盘。
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2
结果：显示辅助选项/声音。
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3
结果：显示辅助选项/显示。
命令： rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4
结果：显示辅助选项/鼠标。
添加新硬件
模块： sysdm.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1
增加新的打印机
模块：shell32.dll
命令：rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter
添加/删除程序
模块：appwiz.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
结果：显示安装/卸载。
命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
结果：显示安装/卸载。
命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2
结果：显示Windows 安装。
命令：rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3
结果：显示启动盘。
复制磁盘
模块：diskcopy.dll
命令：rundll32.exe diskcopy.dll,DiskCopyRunDll
时间/日期
模块： timedate.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,0
结果：显示设置日期/时间。
命令： rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,1
结果：显示设置时间区域。
拨号连接(DUN)
模块： rnaui.dll
命令： rundll32.exe rnaui.dll,RnaDial 连接_名称
结果：打开指定的拨号连接。
例子：
x= Shell("rundll32.exe rnaui.dll,RnaDial " & "连接_名称", 1)
显示器
模块： desk.cpl
结果：背景设置。
命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1
结果：屏幕保护设置。
命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2
结果：外观设置。
命令： rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3
结果：设置窗口。
操纵杆
模块： joy.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL joy.cpl
邮件/传真
模块： mlcfg32.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL mlcfg32.cpl
结果：出现 MS Exchange 属性设置。
邮局设置
模块： wgpocpl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL wgpocpl.cpl
结果：显示 MS Postoffice Workgroup Admin 设置。
主设置
模块： main.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @0
结果：显示鼠标属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1
结果：显示键盘/速度属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,1
结果：显示键盘/语言属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @1,,2
结果：显示键盘/常规属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @2
结果：显示打印机属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @3
结果：显示字体属性。
命令： rundll32.exe shell32.dll,Control_RunDLL main.cpl @4
结果：显示电源管理属性。
增加 Modem
模块：modem.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL modem.cpl,,add
多媒体
模块： mmsys.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0
结果：声音。
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,1
结果：视频。
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2
结果：声音 MIDI。
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3
结果：CD/音乐。
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,4
结果：高级。
命令： rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1
结果：声音。
网络
模块：netcpl.cpl
命令：rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl
打开方式窗口(Open With)
模块： shell32.dll
命令：rundll32.exe shell32.dll,OpenAs_RunDLL path\filename
口令
模块： password.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL password.cpl
区域设置
模块： intl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0
结果：区域设置。
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,1
结果：数字格式设置。
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,2
结果：金额格式设置。
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3
结果：时间格式设置。
命令： rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,4
结果：日期格式设置。
屏幕保护
模块： appwiz.cpl
命令： rundll32.exe desk.cpl,InstallScreenSaver c:\win\system\Flying Windows.scr
结果：安装屏幕保护并显示预览属性页。
系统设置
模块： sysdm.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0
结果：显示常规设置。
命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,1
结果：显示设备管理设置。
命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2
结果：显示硬件设置。
命令： rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,3
结果：显示性能设置。
IE4 设置
模块： inetcpl.cpl
命令： rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl

将文本插入WORD文档
使用 InsertAfter 或 InsertBefore 方法可以在 Selection 或 Range 对象前后插入文字。下面的示例在活动文档结尾处插入文字。
ActiveDocument.Content.InsertAfter Text:=" the end."
下面的示例在所选内容前插入文字。
Selection.InsertBefore Text:="new text "
Range 对象或 Selection 对象在使用了 InsertBefore 或 InsertAfter 方法之后，会扩展并包含新的文本。使用 Collapse 方法可以将 Selection 或 Range 折叠到开始或结束位置。

隐藏和显示任务栏
任务栏一般是显示在窗口的最底下，但有时我们需要隐藏它。
声明：
Dim hWnd1 As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
隐藏的例子：
hWnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
显示的例子：
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)