ms访问Vb挂起并且不生成邮件

时间:2016-01-23 19:32:23

标签: access-vba ms-access-2010

请帮助以下代码不生成邮件并挂起访问应用程序:

问题在哪里我不做dQuery处理电子邮件正确生成但不包括子表单记录。

没有子表单详细信息邮件类似于此Email Generated with Proper variables present on MainForm

Private Sub InformCustomer_Click()

On Error GoTo Err_InformCustomer_Click

Dim CustName As String      ' Customer Name
Dim varTo As Variant        '-- Address for SendObject
Dim stText As String        '-- E-mail text
Dim DelDate As Variant      '-- Rec date for e-mail text
Dim stSubject As String     '-- Subject line of e-mail
Dim stOrderID As String     '-- The Order ID from form
Dim strSQL As String        '-- Create SQL update statement
Dim errLoop As Error

Dim dQuery As String
Dim MyDb As DAO.Database
Dim rs As DAO.Recordset

stOrderID = Me![OdrID]

strSQL = "SELECT BrandName, ModelName, Status " _
& " FROM OrderProdDetails " _
& " WHERE (OrdID)=" & stOrderID & ";"
Set MyDb = CurrentDb
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
While Not rs.EOF
dQuery = dQuery & rs![BrandName].Value & vbTab & rs![ModelName].Value & rs![Status].Value & vbCrLf     
Wend
Set rs = Nothing

CustName = Me![CustName]

varTo = Me![CustEmail]

stSubject = ":: Update - Oder Status ::"

stOrderID = Me![OdrID]
DelDate = Me![OdrDeliveryDate]

stText = "Dear" & CustName & Chr$(13) & _
         "You have been assigned a new ticket." & Chr$(13) & Chr$(13) & _
         "Order Number: " & stOrderID & Chr$(13) & _
          _
         "Please refer to your order status " & Chr$(13) & _
         "Exp Delevery Date: " & DelDate & Chr$(13) & Chr$(13) & _
          dQuery & Chr$(13) & _
         "This is an automated message. Please do not respond to this e-mail."

'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, True

MsgBox "Done"

Exit Sub

Err_InformCustomer_Click:
MsgBox Err.Description
End Sub

1 个答案:

答案 0 :(得分:1)

你创造了一个无限循环。

While Not rs.EOF
    dQuery = dQuery & rs![BrandName].Value & vbTab & rs![ModelName].Value & rs![Status].Value & vbCrLf 
    ' This is missing -->
    rs.MoveNext
Wend