VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - vb设计数据库电子邮件程序(3)
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:7698, 日期:2001-06-14
vb设计数据库电子邮件程序
crystal编译
--------------------------------------------------------------------------------


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