Email with attach. not working

[Janb]

Hi,

When I'm running the code for the first time, everything is fine. But when I'm running the script for the second time it's not working and I recieve the messages/errors in the same order as the screenshots. Below the screenshots you find the code.

What do I need to adjust?

I'm choosing Cancel

Sub SaveActiveSheetAsPDFandSendEmail()

'Deze sub zal het actieve werkblad opslaan als een _
PDF bestand en verzenden als een e-mail.

'Om een e-mail vanuit Excel te kunnen versturen, moeten we refereren naar de _
Microsoft Outlook Object Library. Ga hiervoor naar de VB Editor en vervolgens _
naar: Tools >> References. Scroll net zo lang naar beneden totdat je _
"Microsoft Outlook XX Object Library" tegenkomt. Zet er een vinkje voor en sluit _
af.

'Stap 1
'De locatie en bestandsnaam bepalen

    Dim Locatie As String
    Dim Bestandsnaam As String
    Dim LocatieEnBestandsnaam As String
    
'Je kunt deze drie stappen ook in één stap doen. Persoonlijk geef ik de _
voorkeur aan meedere variabelen. Wanneer er iets gewijzigd moet worden _
is dit veel eenvoudiger. Het geeft ook een beter overzicht en het is _
dynamischer. Denk bijvoorbeeld aan een loop in een bereik waarbij de _
de bestandsnaam afhankelijk is van de waarde in de cel.
    
    Locatie = "C:\Users\XXXXXX\Downloads\" 'Vergeet niet om de backslash (\) toe te voegen
    Bestandsnaam = "Overzicht Salarisen.pdf"
    LocatieEnBestandsnaam = Locatie & Bestandsnaam

'Stap 2
'Het werkblad exporteren als een pdf bestand

    'Ik maak hieronder gebruik van een zogenaamde "CodeName". Wanneer je daar _
    niet bekend mee bent, kun je ook het volgende gebruiken:

    'Activesheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=LocatieEnBestandsnaam
    
    'Het voordeel van een codename is dat het niet uitmaakt of het actieve werkblad _
    wel of niet is geselecteerd.

    shtData.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=LocatieEnBestandsnaam
                                
'Stap 3
'Een aantal variabelen declareren

    Dim Ol As Outlook.Application
    Dim Olemail As Outlook.MailItem
    
'Stap 4
'Outlook openen en een nieuwe E-mail beginnen

    Set Ol = New Outlook.Application
    Set Olemail = Ol.CreateItem(olMailItem)
    
'Stap 5
'De e-mail voorbereiden en verzenden

'Eerst weer een aantal variabelen. Immers het doel is altijd om _
flexibel om te gaan met onze macro's.

    Dim ToName As String
    Dim CCName As String
    Dim BCCName As String
    Dim Subject As String
    Dim Inhoud As String
    
    ToName = "XXXXXXXXX@gmail.com"
    CCName = ""
    BCCName = ""
    Subject = "Een test met bijlage en toelichting"
    
    Inhoud = shtEmail.Range("Aanhef") & vbNewLine & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Tekst_1") & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Tekst_2")
    Inhoud = Inhoud & vbNewLine & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Ondertekening") & vbNewLine & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Naam_ondertekenaar") & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Functie_ondertekenaar") & vbNewLine
    Inhoud = Inhoud & shtEmail.Range("Telefoonnummer_ondertekenaar")
    
    
    With Olemail
        .To = ToName
        .CC = CCName
        .BCC = BCCName
        .Subject = Subject
        .Body = Inhoud
        .Attachments.Add LocatieEnBestandsnaam
        .Send
    End With
    
'stap 6
    
    Kill LocatieEnBestandsnaam
    
'stap 7
'Het geheugen opschonen

    Ol.Quit
    Set Ol = Nothing
    Set Olemail = Nothing
    
End Sub

Cheers,
Jan

 

[rollis13]

Since I can't replicate your error, just a try: don't use ol.Quit since the next Set Ol = Nothing should be enough to clear 'cache'.

 

[Janb]

Since I can't replicate your error, just a try: don't use ol.Quit since the next Set Ol = Nothing should be enough to clear 'cache'.

Thanks rollis13. I did and it worked twice. But the same issue appeared when I ran the code for the 3rd and 4th time.

Cheers, Jan

 

[rollis13]

As said it's impossible for me to replicate your error (even if you attach a dummy file).
All I can suggest is to check in Task Manager if you find active Outlook processes when they are not supposed to be there since Outlook should have closed when your macro ends (unless it takes a long time to complete the forwarding of the email).
Try checking before and after executing your macro. If you don't find such process then, sorry, no other idea on what gets stuck in your PC.

 

[Janb]

As said it's impossible for me to replicate your error (even if you attach a dummy file).
All I can suggest is to check in Task Manager if you find active Outlook processes when they are not supposed to be there since Outlook should have closed when your macro ends (unless it takes a long time to complete the forwarding of the email).
Try checking before and after executing your macro. If you don't find such process then, sorry, no other idea on what gets stuck in your PC.

Hi rollis13,

I just want to let you know that I figured it out. Many thanks for yout time and help.

Sub SaveActiveSheetAsPDFandSendEmail()

'Deze sub zal het actieve werkblad opslaan als een _
PDF bestand en verzenden als een e-mail.

'Stap 1
'De locatie en bestandsnaam bepalen

    Dim Locatie As String
    Dim Bestandsnaam As String
    Dim LocatieEnBestandsnaam As String
    
    Locatie = shtEmailAddress.Range("I4").Value 'Vergeet niet om de backslash (\) toe te voegen
    Bestandsnaam = "Overzicht Salarisen.pdf"
    LocatieEnBestandsnaam = Locatie & Bestandsnaam

'Stap 2
'Het werkblad exporteren als een pdf bestand

    shtData.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=LocatieEnBestandsnaam
                                
'Stap 3
'Een aantal variabelen declareren

    Dim Ol As Outlook.Application
    Dim Olemail As Outlook.MailItem
    
'Stap 4
'Outlook openen en een nieuwe E-mail beginnen

    Set Ol = New Outlook.Application
    
'Stap 5
'De e-mail voorbereiden en verzenden

'Eerst weer een aantal variabelen. Immers het doel is altijd om _
flexibel om te gaan met onze macro's.

    Dim rngEmails As Range
    Dim LastRowEmails As Long
        
    LastRowEmails = shtEmailAddress.Cells(Rows.Count, 3).End(xlUp).Row
    Set rngEmails = shtEmailAddress.Range("C4:C" & LastRowEmails)
    
    Dim ToName As String
    Dim CCName As String
    Dim BCCName As String
    Dim Onderwerp As String
    Dim Inhoud As String
    
    Dim Email As Range
    
    For Each Email In rngEmails
        
        ToName = Range(Email.Address).Offset(0, 0).Value
        CCName = ""
        BCCName = ""
        Onderwerp = Range(Email.Address).Offset(0, 1).Value
        
        Inhoud = "Beste " & Range(Email.Address).Offset(0, 2).Value & vbNewLine & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Tekst_1") & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Tekst_2")
        Inhoud = Inhoud & vbNewLine & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Ondertekening") & vbNewLine & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Naam_ondertekenaar") & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Functie_ondertekenaar") & vbNewLine
        Inhoud = Inhoud & shtEmail.Range("Telefoonnummer_ondertekenaar")

        Set Olemail = Ol.CreateItem(0)
        
        With Olemail
            .To = ToName
            .CC = CCName
            .BCC = BCCName
            .Subject = Onderwerp
            .Body = Inhoud
            .Attachments.Add LocatieEnBestandsnaam
            .Send
        End With
        
        Set Olemail = Nothing
    
    Next Email
        
'stap 6
'Nodig wanneer je de bijlage die tijdelijk is opgeslagen wilt verwijderen.
    
 '   Kill LocatieEnBestandsnaam
    
'stap 7
'Het geheugen opschonen

    Set Ol = Nothing
    Set Olemail = Nothing
    
End Sub

 

[rollis13]

Thanks for the feedback, glad for you that you made it work.