vb设计数据库电子邮件程序

MsgBox "Error opening ODBC registry key."
Exit Sub
End If

dwIndex = 0

'-- Add each DNS to the combo
Do
lpcbValueName = 1000
lpcbData = 1000
lpValueName = String(lpcbValueName, 0)


'-- The RegEnumValue function allows you to
'-- move through the subkeys one at a time
lngResult = RegEnumValue(hKey, _
dwIndex, _
ByVal lpValueName, _
lpcbValueName, _
0&, _
REG_DWORD, _
ByVal lpData, _
lpcbData)
If lngResult = ERROR_SUCCESS Then
strResult = Left(lpValueName, lpcbValueName)
DSNCombo.AddItem strResult
End If
dwIndex = dwIndex 1
Loop While lngResult = ERROR_SUCCESS

RegCloseKey hKey
End Sub


　　RDO Tables

　　为了进入RDO，我在"Microsoft Remote Data Objects 2.0"上添加了一个reference.这个子程序创立了与数据库的连接，而且为Table ComboBox.命名了每个Table 的

　　名称

Private Sub FillTableCombo()

'-- Find all the table names using RDO
On Error GoTo DSNTablesError

Dim myEnviroment As rdoEnvironment
Dim myConnection As rdoConnection

Dim strUID As String
Dim strPWD As String

strUID = PropertyForm.UserNameText
strPWD = PropertyForm.PasswordText

Set myEnviroment = rdoEngine.rdoEnvironments(0)

Set myConnection = myEnviroment.OpenConnection(PropertyForm.DSNCombo.Text, _
Connect:="uid=" & strUID & "; pwd=" & strPWD & ";")

TableCombo.Clear
For Each tb In myConnection.rdoTables
TableCombo.AddItem tb.Name
Next

'-- Clear Fields to avoid mismatched data
FieldCombo.Clear

myConnection.Close
myEnviroment.Close

DSNTablesError:
End Sub


156 　　ADODB Fields

　　与其为ADODB作一个reference，不如通过objects来存取。此子程序将ComboBox作为一个变量参数，可以用来更新Database properties上的Field combo和Secondary Field Combo.。

　　Fill Field Combo使用DNS 及 Table combo boxes提供的信息来打开表格。当型循环会扫描每个域名并将此添加到Field combo上。

Private Sub FillFieldCombo(myCombo As ComboBox)
'-- myCombo - the ComboBox that is to be updated by the subroutine
On Error GoTo DSNTablesError
'--Populate the field combo using ADODB

Dim oTempConnection As Object
Dim oTable As Object

Dim intCount As Integer
Dim intNumOfFields As Integer

Set oTempConnection = CreateObject("ADODB.Connection")
oTempConnection.Open PropertyForm.DSNCombo.Text, _
PropertyForm.UserNameText, PropertyForm.PasswordText
Set oTable = CreateObject("ADODB.RecordSet")
Set oTable.ActiveConnection = oTempConnection

oTable.Source = "SELECT * FROM " & PropertyForm.TableCombo
oTable.Open

intNumOfFields = oTable.Fields.Count
myCombo.Clear

While (intCount < intNumOfFields)
myCombo.AddItem oTable.Fields(intCount).Name
intCount = intCount 1
Wend

oTable.Close
oTempConnection.Close
Exit Sub

DSNTablesError:
MsgBox "Invalid Table Name"
End Sub


　　Outlook Objects

　　FillFolderCombo和FillMailboxCombo 子程序非常类似。都是通过开启至OUTLOOK的连接以及增加combos来运作的。FillMailboxCombo：当用户登入另外的邮箱，则会被默认为是Outlook里的最上层文件夹；FillFolderCombo则是进入专门的邮箱的子文件夹并增加Folder combo。

Private Sub FillFolderCombo()
On Error GoTo Err_Folder
' 'Put the names of all available folders in the folderCombo

Dim myOlApp As Object
Dim olNamespace As Object
Dim iCount As Integer
Dim mystr As String


Set myOlApp = CreateObject("Outlook.Application")
Set olNamespace = myOlApp.GetNameSpace("MAPI")

iCount = 1
FolderCombo.Clear
mystr = MailboxCombo

While iCount <= olNamespace.folders(mystr).folders.Count
FolderCombo.AddItem olNamespace.folders(mystr).folders(iCount).Name
iCount = iCount 1
Wend

Exit Sub
Err_Folder:
MsgBox "Unable to resolve mailbox"
End Sub



Private Sub FillMailboxCombo()
'--Fill in all the names of available mailboxes

Dim myOlApp As Object
Dim olNamespace As Object
Dim iCount As Integer

Set myOlApp = CreateObject("Outlook.Application")
Set olNamespace = myOlApp.GetNameSpace("MAPI")

iCount = 1
MailboxCombo.Clear
While iCount <= olNamespace.folders.Count

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!