Code works but outlook crashes

[Gand114]

Hi dears,
the below code works as expected but unfortunately Outlook seems not to like too much...
I explain better, the code is sending to a list (from a query) of email address an email. To each email it attaches a different file (a ratesheet)

As long as the oMailitem has the command ".display" Outlook open each single mail for me to review and send.
Fo far it's about 80 emails but they are hopefully growing and, since it worked with ."display", I changed it to ".send"

Once i did that it sent around 10 emails then Outlook crashed.
My understanding is that the VBA is working to fast for Outlook to keep pace with it.

Is there any way to solve this?

 Private Sub Comando2_Click()
 'send files as attachment
Dim answer As Integer
answer = MsgBox("si stanno per inviare tutti i listini, continuare?", vbOKCancel, "Attenzione!")
If answer = vbOK Then
 Dim pafi As String
Dim file As String
Dim path As String
Dim ingragsoc As String
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
Dim fulpafi As String
Dim roccodio As String
Dim filnoex As String
Dim strposta As String
Dim htbody As String
Dim strpic As String
Dim strvalidita As String
strvalidita = Me.mesdival
 
   'start outlook just once
Set oOutlook = GetObject(, "Outlook.Application")
'or
'Set oOutlook = CreateObject("outlook.application")
     
    '(file names do not have slashes)
path = "C:\Users\diego.macaluso\Desktop\EXEPE\"
Set rs = CurrentDb.OpenRecordset("qrsocemail")
With rs
    While Not .EOF
        ingragsoc = rs.Fields(0)   'this field has customer names identical to the one in the pdf file
        strposta = rs.Fields(1)   'this have the email address
        strpic = rs.Fields(2)
        
    
        file = "Listino Tetris Consolidation export" & " " & strvalidita & " " & ingragsoc & ".pdf"
        fulpafi = path & file
        htbody = "Buongiorno " & strpic & "," & "<br>"
htbody = htbody & "in allegato trovate il nostro listino export a voi dedicato con validità" & " " & strvalidita & "." & "<br>"
htbody = htbody & "Restiamo naturalmente a disposizione per qualsiasi chiarimento si rendesse necessario" & "<br>"
htbody = htbody & "Cordiali saluti" & "<br>" & "<br>"
        
    
       'If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
          Set oEmailItem = oOutlook.CreateItem(olMailItem)
          signature = oEmailItem.HTMLBody
          With oEmailItem
              
             .Attachments.Add fulpafi
            
             .To = strposta
             .Subject = "Listino Export"
             .HTMLBody = htbody & signature
        .Send
        
           End With
       
       .MoveNext   'next record
     
       
    Wend
End With
  rs.Close
Set oEmailItem = Nothing
Set oOutlook = Nothing
Set rs = Nothing
Set db = Nothing
 End If
  
 end sub

Thanks for your help on this! -meanwhile I ll be sending the remaining 70 email manually

 

[JHB]

..
My understanding is that the VBA is working to fast for Outlook to keep pace with it.

Then put DoEvents in your code.
A way to find out if the code run to fast is to put in some breakpoints in your code, each time the code stops, then wait a little and continue the code.

 

[GohDiamond]

Use the GetObject function when there is a current instance of the object, use CreateObject to startup a separate instance...

if you have a single instance of Outlook open and it's doing other things automatically like, checking for mail from your ISP every 5 minutes this could cause a conflict as well...

Have you tried launching a second instance for your custom process? does it still crash on you if you do it that way?

Just a thought
Cheers,
Goh