訪問2007年VBA報告電子郵件每公司

我有一個供應商的報告約150頁訪問2007年。每個報告的地址，電子郵件聯繫人，電話號碼，產品和公司的名稱每頁。每月一次，我必須發送電子郵件給供應商，以確認聯繫人地址，電話號碼和產品的更改。訪問2007年VBA報告電子郵件每公司

我想發送特定的報告給該特定的電子郵件，而不是整個報告。我希望這是自動的。

我已經在VBA上編寫代碼，經過網絡研究後仍然無法工作。我得到太多的參數。預期1.錯誤。

下面是帶有發送報告按鈕的我的表單的代碼。

Dim strSql As String 
Dim strSubject As String 
Dim strMsgBody As String 
strSql = "SELECT DISTINCT Name, EMail FROM [Suppliers and Products]" 

Set dbs = CurrentDb 
Set rst = dbs.OpenRecordset(strSql) 

'loop through the recordset 

Do While Not rst.EOF 
    ' grab email string 

    strEmail = rst.Fields("EMail") 

    ' grab name 
    strName = rst.Fields("Name") 

    Call fnUserID(rst.Fields("EMail")) 

    'send the pdf of the report to curent supplier 
    On Error Resume Next 

    strSubject = "September 2012 Supplier's Listing" 
    strMsgBody = "2008 Procedure Review Attached" 
    DoCmd.SendObject acSendReport, "Suppliers Confirmation forms", acFormatHTML, strEmail, , , strSubject, strMsgBody, False 

    If Err.Number <> 0 Then 
     MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "Delivery Failure to the following email address: " & strEmail 
    End If 

    On Error GoTo PROC_ERR 

    ' move and loop 
    rst.MoveNext 
Loop 

' clean up 
rst.Close 
Set rst = Nothing 
dbs.Close 
Set dbs = Nothing 

PROC_Exit: 
Exit Sub 

PROC_ERR: 
MsgBox Err.Description 
Resume PROC_Exit

我有下面的代碼

Option Compare Database 

Public Function fnUserID(Optional Somevalue As Variant = Null, Optional reset As Boolean = False) As Variant 
    Static EMail As Variant 
    If reset Or IsEmpty(EMail) Then EMail = Null 
    If Not IsNull(Somevalue) Then EMail = Somevalue 

    fnUserID = EMail 
End Function 

Public Function SendReportByEmail(strReportName As String, strEmail As String) 
    On Error GoTo PROC_ERR 

    Dim strRecipient As String 
    Dim strSubject As String 
    Dim strMessageBody As String 
    'set the email variables 
    strRecipients = strEmail 
    strSubject = Reports(strReportName).Caption 
    strMessageBody = "May 2012 Suppliers' List " 

    ' send report as HTML 
    DoCmd.SendObjectac acSendReport, strReportName, acFormatHTML, strRecipients, , , strSubject, strMessageBody, False 
    SendReportByEmail = True 

    PROC_Exit: 
    Exit Function 
    Proc Err: 

    SendReportByEmail = False 

    If Err.Number = 2501 Then 
     Call MsgBox("The email was not sent for " & strEmail & ".", vbOKOnly + vbExclamation + vbDefaultButton1, "User Cancelled Operation") 
     Else: MsgBox Err.Description 
    End If 
    Resume PROC_Exit 

End Function

查詢這是報告中獲取其數據具有以下SQL模塊。

SELECT Names.Name, Names.Phys_Address, 
     Names.Telephones, Names.Fax, Names.EMail, 
     Names.Web, Names.Caption AS Expr1, [Products by Category].CatName, 
     [Products by Category].ProdName 
FROM [Names] 
INNER JOIN [Products by Category] 
ON Names.SuppID=[Products by Category].SupID 
WHERE ((Names.EMail = fnUserID()) or (fnUserID() Is Null));

請幫助，因爲我堅持我要去哪裏錯了。

來源

2012-05-31 Sithelo

您正在使用Name作爲字段名稱，這是一個非常糟糕的主意。這是一個[保留字]（http://support.microsoft.com/kb/286335），隨着您的進行，將引發越來越多的問題。始終縮進您的代碼。避免出現「出錯繼續下一步」，它掩蓋了問題，並且幾乎不是一個好主意。 – Fionnuala

您的報告是否自行打開？什麼行給出錯誤？註釋掉你的錯誤編碼，以便得到一條失敗的線路。 – Fionnuala

數據庫已創建。其中一個領域是名稱。報告沒有公開。我創建了它，它只有一個發送按鈕和我發佈的代碼。 – Sithelo

一些筆記。

On Error GoTo PROC_ERR 

Dim qdf As QueryDef 
Dim strSQL As String 
Dim strSubject As String 
Dim strMsgBody As String 

strSQL = "SELECT DISTINCT [Name], EMail, SuppID FROM Names " _ 
     & "INNER JOIN [Products by Category] " _ 
     & "ON Names.SuppID=[Products by Category].SupID " 

Set dbs = CurrentDb 
Set rst = dbs.OpenRecordset(strSql) 

qrySQL = "SELECT Names.Name, Names.Phys_Address, " _ 
     & "Names.Telephones, Names.Fax, Names.EMail, " _ 
     & "Names.Web, Names.Caption AS Expr1, " _ 
     & "[Products by Category].CatName, " _ 
     & "[Products by Category].ProdName " _ 
     & "FROM [Names] " _ 
     & "INNER JOIN [Products by Category] " _ 
     & "ON Names.SuppID=[Products by Category].SupID " 

'loop through the recordset 

Do While Not rst.EOF 
    ' grab email string 

    strEmail = rst.Fields("EMail") 

    ' grab name 
    strName = rst.Fields("Name") 

    ' You should check that the email is not null 
    Call fnUserID(rst.Fields("EMail")) 

    'send the pdf of the report to curent supplier 
    'On Error Resume Next 

    'The query that the report uses 
    Set qdf = CurrentDB.QueryDefs("Suppliers and Products") 
    qdf.SQL = qrySQL & " WHERE SuppID=" & rst!SuppID 

    strSubject = "September 2012 Supplier's Listing" 
    strMsgBody = "2008 Procedure Review Attached" 
    DoCmd.SendObject acSendReport, "Suppliers Confirmation forms", _ 
     acFormatHTML, strEmail, , , strSubject, strMsgBody, False 

    ' move and loop 
    rst.MoveNext 
Loop 

''Reset the query 
qdf.SQL = qrySQL 

rst.Close 
Set rst = Nothing 
dbs.Close 
Set dbs = Nothing 

PROC_Exit: 
Exit Sub 

PROC_ERR: 
    If Err.Number <> 0 Then 
     MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, _ 
      "Delivery Failure to the following email address: " & strEmail 
    End If 
MsgBox Err.Description 
Resume PROC_Exit

來源

2012-05-31 14:45:58 Fionnuala

我已經實現了代碼。非常感謝你。變量qdf給我一個錯誤。我應該如何聲明？ – Sithelo

糟糕，應該是'Set qdf'，qdf可以聲明爲QueryDef（DAO） – Fionnuala

非常感謝。但是發送的表單沒有數據。它與我的標籤。e地址電話傳真電子郵件和網絡沒有領域去與它。 – Sithelo

訪問2007年VBA報告電子郵件每公司

回答

相關問題