用Access发邮件时的问题,帮忙看下

cloudsky

我写了一个发邮件的函数,奇怪的是:如果只发少数几封邮件,很正常可以收得到,但是如果连续发20封的话,只会发出一两封,然后会弹出一个窗口提示内存不够,以后就再也发不出去了,必段重新启动ACCESS才可以发,但也只能发出一两封
源代码如下:
'------------------------------------------------------------
' SendMail
'------------------------------------------------------------
Function SendMail(id As Integer, UserName As String, EmailAddr As String)
On Error GoTo SendMail_Err
    'Dim id As Integer
    Dim cont As String 'condition for open report
    Dim subject As String
    cont = "[id]=" & id
    subject = UserName & ",Please find attached your pay slip for " & Month(Now())
    DoCmd.SetWarnings False
    DoCmd.OpenReport "Report_2003", acPreview, "", cont
    DoCmd.SendObject acReport, "Report_2003", "SnapshotFormat(*.snp)", EmailAddr, "", "", subject, "", False, ""
    DoCmd.Close acReport, "Report_2003"


SendMail_Exit:
    Exit Function

SendMail_Err:
    MsgBox Err.Description
    Resume SendMail_Exit

End Function


send 按钮单击事件代码
Private Sub Send_Click()
On Error GoTo Err_Send_Click
    Dim db1 As DAO.Database
    Dim User As DAO.Recordset
   
    Set db1 = Application.CurrentDb
    Set User = db1.OpenRecordset("Transfer", dbOpenTable)
   
    Dim FailUser As String
    FailUser = "There some user's email is empty!  "
    With User
        Do While Not User.EOF
            If IsNull(![E-mail Address]) Then
                FailUser = FailUser & "      " & ![EMPLOYEE NAME]
            Else
                SendMail ![id], ![EMPLOYEE NAME], ![E-mail Address]
            End If
            .MoveNext
        Loop
    End With
    MsgBox FailUser
Exit_Send_Click:
    Exit Sub

Err_Send_Click:
    MsgBox Err.Description
    Resume Exit_Send_Click
End Sub

高手帮帮忙吧!

eio

将程序发上来看看吧

cloudsky

这是源文件。
多谢!

eio

控件丢失：msadox.dll

cloudsky

加了以后还是一样啊
eie，请问你那可以正常发邮件吗？

cloudsky

出错提示

cloudsky

准确的说是每次发了两封就不行了

eio

我是说，我没有控件，无法调试阿？

cloudsky

请将文件名改为msadox.dll复制到你的机器上
多谢你了

[此贴子已经被作者于2003-8-18 14:46:57编辑过]

eio

哇哇，怎么不改RAR？