138.htm

vb功能实例介绍。详细、很好的实例说明。

<p>vb设计数据库电子邮件程序(5)</p>
<p></p>
<p></p>
<p>　　下面是RDO TABLES 代码 </p>
<p></p>
<p>API Call to registry </p>
<p>Public Const HKEY_CURRENT_USER = &H80000001 </p>
<p></p>
<p>Public Const ERROR_SUCCESS = 0& </p>
<p></p>
<p>Public Const SYNCHRONIZE = &H100000</p>
<p>Public Const STANDARD_RIGHTS_READ = &H20000</p>
<p>Public Const KEY_QUERY_VALUE = &H1</p>
<p>Public Const KEY_ENUMERATE_SUB_KEYS = &H8</p>
<p>Public Const KEY_NOTIFY = &H10 </p>
<p></p>
<p>Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _</p>
<p>KEY_QUERY_VALUE Or _</p>
<p>KEY_ENUMERATE_SUB_KEYS Or _</p>
<p>KEY_NOTIFY) And _</p>
<p>(Not SYNCHRONIZE)) </p>
<p></p>
<p>Public Const REG_DWORD = 4 </p>
<p></p>
<p></p>
<p>Public Declare Function RegOpenKeyEx Lib "advapi32.dll" _</p>
<p>Alias "RegOpenKeyExA" _</p>
<p>(ByVal hKey As Long, _</p>
<p>ByVal lpSubKey As String, _</p>
<p>ByVal ulOptions As Long, _</p>
<p>ByVal samDesired As Long, phkResult As Long) As Long </p>
<p></p>
<p>Public Declare Function RegEnumValue Lib "advapi32.dll" _</p>
<p>Alias "RegEnumValueA" _</p>
<p>(ByVal hKey As Long, _</p>
<p>ByVal dwIndex As Long, _</p>
<p>ByVal lpValueName As String, _</p>
<p>lpcbValueName As Long, _</p>
<p>ByVal lpReserved As Long, _</p>
<p>lpType As Long, _</p>
<p>lpData As Any, _</p>
<p>lpcbData As Long) As Long </p>
<p></p>
<p>Public Declare Function RegCloseKey Lib "advapi32.dll" _</p>
<p>(ByVal hKey As Long) As Long </p>
<p></p>
<p>注释：-- The subroutine FillODBCCombo is called when the Properties form is loaded.</p>
<p>注释：-- First the root ODBC key is opened. By iterating through its sub-keys,</p>
<p>注释：-- all of the installed DNS注释：s are found and inserted into the DNS ComboBox. </p>
<p></p>
<p></p>
<p>Public Sub FillODBCCombo()</p>
<p>注释：-- Load in names of all installed ODBC database (From registry) </p>
<p></p>
<p>Dim hKey As Long </p>
<p></p>
<p>Dim dwIndex As Long</p>
<p>Dim lpData As Long</p>
<p>Dim lpcbData As Long</p>
<p></p>
<p>Dim lngResult As Long</p>
<p>Dim strResult As String</p>
<p>Dim lpValueName As String</p>
<p>Dim lpcbValueName As Long</p>
<p></p>
<p>注释：-- Each ODBC Data source has a key located in</p>
<p>注释：-- HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources.</p>
<p>注释：-- By finding the name of each key, we can gather all the DNS注释：s of</p>
<p>注释：-- the installed ODBC databases for the current user</p>
<p>lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, _</p>
<p>"Software\ODBC\ODBC.INI\ODBC Data Sources", _</p>
<p>0&, _</p>
<p>KEY_READ, _</p>
<p>hKey)</p>
<p>If lngResult <> ERROR_SUCCESS Then</p>
<p>MsgBox "Error opening ODBC registry key."</p>
<p>Exit Sub</p>
<p>End If</p>
<p></p>
<p>dwIndex = 0</p>
<p></p>
<p>注释：-- Add each DNS to the combo</p>
<p>Do</p>
<p>lpcbValueName = 1000</p>
<p>lpcbData = 1000</p>
<p>lpValueName = String(lpcbValueName, 0)</p>
<p></p>
<p></p>
<p>注释：-- The RegEnumValue function allows you to</p>
<p>注释：-- move through the subkeys one at a time</p>
<p>lngResult = RegEnumValue(hKey, _</p>
<p>dwIndex, _</p>
<p>ByVal lpValueName, _</p>
<p>lpcbValueName, _</p>
<p>0&, _</p>
<p>REG_DWORD, _</p>
<p>ByVal lpData, _</p>
<p>lpcbData)</p>
<p>If lngResult = ERROR_SUCCESS Then</p>
<p>strResult = Left(lpValueName, lpcbValueName)</p>
<p>DSNCombo.AddItem strResult</p>
<p>End If</p>
<p>dwIndex = dwIndex + 1</p>
<p>Loop While lngResult = ERROR_SUCCESS</p>
<p></p>
<p>RegCloseKey hKey</p>
<p>End Sub </p>
<p></p>
<p></p>
<p></p>
<p>　　RDO Tables </p>
<p></p>
<p>Private Sub FillTableCombo() </p>
<p></p>
<p>注释：-- Find all the table names using RDO</p>
<p>On Error GoTo DSNTablesError </p>
<p></p>
<p>Dim myEnviroment As rdoEnvironment</p>
<p>Dim myConnection As rdoConnection </p>
<p></p>
<p>Dim strUID As String</p>
<p>Dim strPWD As String</p>
<p></p>
<p>strUID = PropertyForm.UserNameText</p>
<p>strPWD = PropertyForm.PasswordText</p>
<p></p>
<p>Set myEnviroment = rdoEngine.rdoEnvironments(0) </p>
<p></p>
<p>Set myConnection = myEnviroment.OpenConnection(PropertyForm.DSNCombo.Text, _</p>
<p>Connect:="uid=" & strUID & "; pwd=" & strPWD & ";") </p>
<p></p>
<p>TableCombo.Clear</p>
<p>For Each tb In myConnection.rdoTables</p>
<p>TableCombo.AddItem tb.Name</p>
<p>Next</p>
<p></p>
<p>注释：-- Clear Fields to avoid mismatched data</p>
<p>FieldCombo.Clear</p>
<p></p>
<p>myConnection.Close</p>
<p>myEnviroment.Close</p>
<p></p>
<p>DSNTablesError:</p>
<p>End Sub </p>
<p></p>
<p></p>
<p>　　ADODB Fields </p>
<p></p>
<p>Private Sub FillFieldCombo(myCombo As ComboBox)</p>
<p>注释：-- myCombo - the ComboBox that is to be updated by the subroutine </p>
<p>On Error GoTo DSNTablesError</p>
<p>注释：--Populate the field combo using ADODB </p>
<p></p>
<p>Dim oTempConnection As Object</p>
<p>Dim oTable As Object</p>
<p></p>
<p>Dim intCount As Integer</p>
<p>Dim intNumOfFields As Integer</p>
<p></p>
<p>Set oTempConnection = CreateObject("ADODB.Connection")</p>
<p>oTempConnection.Open PropertyForm.DSNCombo.Text, _</p>
<p>PropertyForm.UserNameText, PropertyForm.PasswordText</p>
<p>Set oTable = CreateObject("ADODB.RecordSet")</p>
<p>Set oTable.ActiveConnection = oTempConnection</p>
<p></p>
<p>oTable.Source = "SELECT * FROM " & PropertyForm.TableCombo</p>
<p>oTable.Open</p>
<p></p>
<p>intNumOfFields = oTable.Fields.Count</p>
<p>myCombo.Clear</p>
<p></p>
<p>While (intCount < intNumOfFields)</p>
<p>myCombo.AddItem oTable.Fields(intCount).Name</p>
<p>intCount = intCount + 1</p>
<p>Wend</p>
<p></p>
<p>oTable.Close</p>
<p>oTempConnection.Close</p>
<p>Exit Sub</p>
<p></p>
<p>DSNTablesError:</p>
<p>MsgBox "Invalid Table Name"</p>
<p>End Sub </p>
<p></p>
<p></p>
<p></p>
<p></p>
<p>　　Outlook Objects </p>
<p></p>
<p>Private Sub FillFolderCombo()</p>
<p>On Error GoTo Err_Folder</p>
<p>注释： 注释：Put the names of all available folders in the folderCombo</p>
<p></p>
<p>Dim myOlApp As Object</p>
<p>Dim olNamespace As Object</p>
<p>Dim iCount As Integer</p>
<p>Dim mystr As String</p>
<p></p>
<p></p>
<p>Set myOlApp = CreateObject("Outlook.Application")</p>
<p>Set olNamespace = myOlApp.GetNameSpace("MAPI")</p>
<p></p>
<p>iCount = 1</p>
<p>FolderCombo.Clear</p>
<p>mystr = MailboxCombo</p>
<p></p>
<p>While iCount <= olNamespace.folders(mystr).folders.Count</p>
<p>FolderCombo.AddItem olNamespace.folders(mystr).folders(iCount).Name</p>
<p>iCount = iCount + 1</p>
<p>Wend</p>
<p></p>
<p>Exit Sub</p>
<p>Err_Folder:</p>
<p>MsgBox "Unable to resolve mailbox"</p>
<p>End Sub </p>
<p></p>
<p></p>
<p></p>
<p></p>
<p>Private Sub FillMailboxCombo()</p>
<p>注释：--Fill in all the names of available mailboxes </p>
<p></p>
<p>Dim myOlApp As Object</p>
<p>Dim olNamespace As Object</p>
<p>Dim iCount As Integer</p>
<p></p>
<p>Set myOlApp = CreateObject("Outlook.Application")</p>
<p>Set olNamespace = myOlApp.GetNameSpace("MAPI")</p>
<p></p>
<p>iCount = 1</p>
<p>MailboxCombo.Clear</p>
<p>While iCount <= olNamespace.folders.Count</p>
<p>MailboxCombo.AddItem olNamespace.folders(iCount).Name</p>
<p>iCount = iCount + 1</p>
<p>Wend</p>
<p>End Sub  </p>