将Access和Outlook与VBA集成以进行定期报告

时间:2012-08-27 18:08:55

标签: vba ms-access outlook

我希望在访问中整理一些VBA代码,一次发送一堆电子邮件。这些电子邮件每个都有多个附件和多个收件人。

我在Access中有一个表,其中主键是“电子邮件报告名称”列表,每列包含此电子邮件报告所在的电子邮件地址。

在另一个表格中,我还有“电子邮件报告名称”,每列都是要附加到该电子邮件的文件的硬盘上的文件路径。

我还有两个查询调用这些表并按电子邮件报告名称过滤,该名称由自定义函数填充到条件字段中。

我已经将outlook编码工作正常,可以从Access发送电子邮件。但我完全不知道如何让它循环遍历不同的“电子邮件报告名称”,然后从这些查询中提取相关信息以填写收件人列表和附件列表。

很抱歉不包含任何示例代码,但我真的出海了,甚至不知道从哪里开始。

如果有任何纯VBA的解决方案,没有适合的SQL。我还不知道任何SQL,所以即使我最初使用它,我也很难修改代码。

谢谢,


SELECT FilePaths.MailItem, FilePaths.FilePath1, 
       FilePaths.FilePath2, FilePaths.FilePath2, 
       FilePaths.FilePath4, FilePaths.FilePath5, 
       FilePaths.FilePath6, FilePaths.FilePath7,
       FilePaths.FilePath8, FilePaths.FilePath9, 
       FilePaths.FilePath10, FilePaths.FilePath11, 
       FilePaths.FilePath12, FilePaths.FilePath13, 
       FilePaths.FilePath14, FilePaths.FilePath15, 
       FilePaths.FilePath16 
FROM FilePaths 
WHERE (((FilePaths.MailItem)=EmailItemSelect()));

1 个答案:

答案 0 :(得分:2)

设置表格的最佳方法是:

EmailAddresses

ID 
EmailAddress
OtherDetails

文件路径

ID
MailItem
FilePath

EmailaddressFilepath

FilePathID
AddressID

我不是在起诉什么邮件,所以我把它留在了。

表EmailaddressFilepath包含一个匹配,用于接收哪些项目。

EmailAddresses

ID     EmailAddress    OtherDetails
1      joe@example.com Joe Bloggs

文件路径

ID    MailItem    FilePath
1     Help        z:\docs\help.doc
2     More help   z:\docs\morehelp.doc

EmailaddressFilepath

FilePathID    AddressID
   1              1
   2              1

然后你需要一些代码

Dim rs As Recordset
Dim db as Database

''Something like
sSQL="SELECT EmailAddress, Filepath " _
    & "FROM ( EmailaddressFilepath " _
    & "INNER JOIN EmailAddresses ON " _
    & "EmailaddressFilepath.AddressID = EmailAddresses.ID) " _
    & "INNER JOIN Filepaths ON EmailaddressFilepath.FilePathID = Filepaths.ID " _
    & "WHERE FilePathID=1"


Set rs = db.Openrecordset(sSQL)

'You now have a recordset with email addresses and attachments
'there would be other approaches, but this will do for now.

 Do While Not rs.EOF
     sEmail=rs!Email
     'set up outlook email

     Do While rs!Email=sEmail
     ''Attachment
         sAttach=rs!Filepath 
         rs.MoveNext
         If rs.Eof Then
            exit loop
         End if
     Loop
 Loop