Почему VB дал мне эту ошибку, при попытке отправить электронную почту? - PullRequest
Новая
       45

Почему VB дал мне эту ошибку, при попытке отправить электронную почту?

0 голосов
/ 26 февраля 2019

Я борюсь с этим кодом.Я пытаюсь отправить массовую почту, но каждый раз появляется следующее сообщение об ошибке:

«Не будет отправлено сообщений электронной почты, поскольку в списке нет записей».

Это мой код: 

Sub SendQuickEmail()

Dim strFP As String
Dim strFN As String
Dim sigstring As String
Dim signature, signature2 As String
Dim strsubject As String


If Forms![Dashboard].[Manage Company Emails]![mceTxtSigName] <> "" Then

sigstring = Environ("appdata") & _
                "\Microsoft\Signatures\" & Forms![Dashboard].[Manage Company Emails]![mceTxtSigName] & ".htm"
Else
MsgBox "Don't forget to put your signature name in!"
GoTo skipped
End If


strsubject = "Update"

 If Dir(sigstring) <> "" Then
        signature = GetBoiler(sigstring)
    Else
        signature = ""
    End If

signature2 = Replace(signature, "Max_files/image001.gif", "http://files.softicons.com/download/social-media-icons/color-social-media-icons-by-uiconstock/png/24x24/facebook.png")
signature = signature2
signature2 = Replace(signature, "Max_files/image002.gif", "http://files.softicons.com/download/social-media-icons/color-social-media-icons-by-uiconstock/png/24x24/twitter.png")
signature = signature2
signature2 = Replace(signature, "Max_files/image003.gif", "http://files.softicons.com/download/social-media-icons/color-social-media-icons-by-uiconstock/png/24x24/linkdin.png")
signature = signature2

Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
' prevent error if outlook is closed
On Error Resume Next
Err.Clear
Set oOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set oOutlook = New Outlook.Application
End If

Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
 .Subject = strsubject
 .HTMLBody = "<font face=""calibri"" size=""3""> Dear " & [Forms]![Dashboard].[dshfName] & ", <br><br> <br><br></font>" & signature
 .To = [Forms]![Dashboard].[dshEmail]
 .Display
End With

Dim workupdate As String

workupdate = "INSERT INTO Worked ( [First], [Last], Company, [Last Contact], Type, Notes, Who ) VALUES (Forms![Dashboard].[dshfName], Forms![Dashboard].[dshlName], Forms![Dashboard].[dshCompany1], date(), 'eMail', 'Courtesy Email from the quick button', Forms![Dashboard].[dshMyName]);"

DoCmd.SetWarnings False
DoCmd.RunSQL workupdate
DoCmd.SetWarnings True

Set oEmailItem = Nothing
Set oOutlook = Nothing
skipped:





End Sub

Кто-нибудь знает что-нибудь еще об этой проблеме?Что я могу сделать, чтобы эта функция массовой почты работала?Спасибо.

...