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

'-- the installed ODBC databases for the current user
lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, _
"Software\ODBC\ODBC.INI\ODBC Data Sources", _
0&, _
KEY_READ, _
hKey)
If lngResult <> ERROR_SUCCESS Then
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

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

　　ADODB Fields

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

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
MailboxCombo.AddItem olNamespace.folders(iCount).Name
iCount = iCount 1
Wend
End Sub


156 　　获得和修改注册表设置

'-- Property form load event
'-- Load all registry settings
DSNCombo = GetSetting("EmailMaker", "Database", "DSN", "OLE_DB_NWind_Jet")
TableCombo = GetSetting("EmailMaker", "Database", "Table", "Customers")

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