VB技巧

表或查询是否存在

在 VB5 中需要 Microsoft DAO 3.x Object Library。

Public Const NameNotInCollection = 3265
Dim DB As Database

Private Function ExistsTableQuery(TName As String) As Boolean

Dim Test As String
On Error Resume Next

' 该名字在表名中是否存在。
Test = db.TableDefs(TName).Name
If Err <> NameNotInCollection Then
ExistsTableQuery = True
' Reset the error variable:
Err = 0
' 该名字在查询中是否存在。
Test = db.QueryDefs(TName$).Name
If Err <> NameNotInCollection Then
ExistsTableQuery = True
End If
End If
End Function

建立和删除一个 DSN

1. 增加声明:

Private Const ODBC_ADD_DSN = 1 ' Add data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const vbAPINull As Long = 0& ' NULL Pointer

Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

2. 新增加一个 DSN

Dim intRet As Long
Dim strDriver As String
Dim strAttributes As String

'设置数据库类别 这里是 SQL Server
strDriver = "SQL Server"
'null 结尾的参数
'请看相关文档
strAttributes = "SERVER=SomeServer" & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=Temp DSN" & Chr$(0)
strAttributes = strAttributes & "DSN=DSN_TEMP" & Chr$(0)
strAttributes = strAttributes & "DATABASE=pubs" & Chr$(0)
strAttributes = strAttributes & "UID=sa" & Chr$(0)
strAttributes = strAttributes & "PWD=" & Chr$(0)
'如果要显示对话，可使用 Form1.Hwnd 代替 vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)
If intRet Then
MsgBox "DSN 建立"
Else
MsgBox "失败"
End If

3. 删除一个 DSN

Dim intRet As Long
Dim strDriver As String
Dim strAttributes As String

strDriver = "SQL Server"
strAttributes = "DSN=DSN_TEMP" & Chr$(0)
intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, strDriver, strAttributes)
If intRet Then
MsgBox "DSN 删除"
Else
MsgBox "失败"
End If

压缩修复数据库

1. Create a new project in Visual Basic. Form1 is created by default.
2. Add a Common Dialog control to Form1. CommonDialog1 is created by
default.
3. Add a Command Button control to Form1. Command1 is created by
default. Set its Caption property to "Repair".
4. Add the following code to the Click event for Command1:

Private Sub Command1_Click()
On Error GoTo Repair_Error
Dim MDB_Name As String

CommonDialog1.Filter = "Access (*.mdb)|*.mdb"
CommonDialog1.Flags = &H1000
CommonDialog1.FilterIndex = 1
CommonDialog1.Action = 1

If CommonDialog1.FileName <> "" Then
Screen.MousePointer = 11
MDB_Name = CommonDialog1.FileName
RepairDatabase (MDB_Name)
Screen.MousePointer = 0
MsgBox "Database repaired successfully", 64, "Repair"
End If
Screen.MousePointer = 0
Exit Sub
Repair_Error:
MsgBox "Error when repairing database", 16, "Error"
Screen.MousePointer = 0
Exit Sub
End Sub

5. Add a second Command Button control to Form1. Command2 is created
by default. Set its Caption property to "Compact".
6. Add the following code to the Click event for Command2:

Private Sub Command2_Click()
On Error GoTo Compact_Error

Dim MDB_Name As String
Dim MDB_NewName As String
Dim MDB_Local As String
Dim MDB_Options As String

MDB_NewName = "c:/dummy.mdb"
CommonDialog1.Filter = "Access (*.MDB)|*.mdb"
CommonDialog1.Flags = &H1000
CommonDialog1.FilterIndex = 1
CommonDialog1.Action = 1

If CommonDialog1.FileName <> "" Then
MDB_Name = CommonDialog1.FileName
CompactDatabase MDB_Name, MDB_NewName & MDB_Local & MDB_Options
Kill MDB_Name
Name MDB_NewName & MDB_Local & MDB_Options As MDB_Name
MsgBox "Database compressed OK", 64, "Compact"
End If
Exit Sub
Compact_Error:
MsgBox "Unable to compress database", 16, "Error"
Exit Sub
End Sub