获取访问权限以将动态地址发送到动态地址

时间:2013-04-02 16:40:31

标签: ms-access access-vba ms-access-2010

这是在Access 2010中,我几乎没有经验或对VBA的熟悉。

在我的表单(frmEmailLookup)中,我有组合框和列表框以及子窗体设置,以便当用户从cmbBuilding中选择建筑物时,表单的其余部分将填充该建筑物上的数据,包括联系人电子邮件大楼内最多4人(lstBuildingRepEmail1,lstBuildingRepEmail2,lstBuildingRepEmail3,lstBuildingRepEmail4)。我需要一个按钮(但是电子邮件记录)来生成一个电子邮件,其中包含来自子表单(qryBuildingAreaLookup)的查询作为附件。我可以设置一个关闭的宏,但它不允许动态电子邮件地址。我不希望我的用户必须在程序中进行更新以进行更新。

感谢任何帮助,我知道我要求大量代码编写帮助。

这是我尝试过的:

    Option Compare Database
Private Sub butEmailRecords_Click()
Dim outputFileName As String
outputFileName = CurrentProject.Path & "\BuildingInventory" & ".xlsx"
DoCmd.TransferSpreadsheet acExport,      acSpreadsheetTypeExcel9, "qryBuildingAreaLookup",     outputFileName, True

On Error GoTo Error_Handler
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("qryBuildinAreaLookup")
With rs

With objEmail
.To = tblBuilding.BuildingRep1
.To = tblBuilding.BuildingRep2
.To = tblBuilding.BuildingRep3
.To = tblBuilding.BuildingRep4
.Subject = "Look at this sample attachment"
.body = "The body doesn't matter, just the attachment"
.Attachments.Add "L:\Administration\FacilityInventoryDatabase\BuildingInventory.xls    x"
.Send
'.ReadReceiptRequested
End With
Exit_Here:
Set objOutlook = Nothing
Exit Sub

Error_Handler:
MsgBox Err & ": " & Err.Description
Resume Exit_Here
End Sub

2 个答案:

答案 0 :(得分:0)

以下是我使用的基础知识:

'Refers to Outlook's Application object
Dim appOutlook As Object

'Refers to an Outlook email message
Dim appOutlookMsg As Object

'Refers to an Outlook email recipient
Dim appOutlookRec As Object

'Create an Outlook session in the background
Set appOutlook = CreateObject("Outlook.Application")

'Create a new empty email message
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)

'Using the new, empty message...
With appOutlookMsg

'SQL statement to grab emails

Set recordset = currentdb.openrecordset('SQL statement')

Do While Not recorset.EOF
Set appOutlookRec = .Recipients.Add(recordset.Email)
appOutlookRec.Type = olTo
recordset.MoveNext
Loop

.Subject = ....
.Body = ....
.Send

End With

这就是我使用的基础知识。我是初学者,所以这可能不是最好的方式,但它应该是一个开始。 (我还必须在参考库中添加Microsoft Oulook。)

答案 1 :(得分:0)

我使用CDO对象发送消息,因为我不想依赖Outlook(任何事情)。

有一篇关于使用CDO发送邮件(包括可下载的VBA代码)的全面文章:

http://www.cpearson.com/excel/Email.aspx