Code .body in sendmail + opmaak

SlootsJ · 8 okt 2019

Hi,

Onderstaande code krijg ik niet aan de praat, het gaat om het stukje .body.

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    EmailManager = Range("EmailManager")
    EmailBCC = Range("EmailBCC")
    EmailCC = Range("EmailCC")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .body = <b>Overzicht afspraken</b>
        
                <b>Communicatie</b>
                "(Sheets("blad1").Range("C16"))"
                
                <b>Plannen & Organiseren</b>
                "(Sheets("blad1").Range("C29"))"
                
                <b>Initiatef</b>
                "(Sheets("blad1").Range("C45"))"
                
                <b>Coachen en Samenwerken</b>
                "(Sheets("blad1").Range("C61"))"
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Hierbij ook het bestand bijgevoegd zonder beveiliging.

Met vriendelijke groet,

Jeroen

OctaFish · 8 okt 2019

Je fout kun je zo oplossen:

Code:

        .htmlbody = "<b>Overzicht afspraken:</b>"

SlootsJ · 8 okt 2019

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    EmailManager = Range("EmailManager")
    EmailBCC = Range("EmailBCC")
    EmailCC = Range("EmailCC")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = "<b>Overzicht afspraken:</b>"
        
        "<b>Communicatie:</b>"
        & Join(Application.Transpose(Sheets("Blad1").Range("C16")), vbCrLf)
        
        "<b>Plannen en organiseren</b>"
        & Join(Application.Transpose(Sheets("Blad1").Range("C29")), vbCrLf)
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Het document geeft aan dat er iets niet klopt.

OctaFish · 8 okt 2019

Bij mij doet-ie het, al heb ik alleen de eerste regel getest. Je hebt er wel een lege tekstregel tussenzitten, en je combineert de regels niet.

Code:

        .htmlbody = "<b>Overzicht afspraken:</b><Br>" _
             & "<b>Communicatie:</b><Br>"" _
             & Join(Application.Transpose(Sheets("Blad1").Range("C16")), vbCrLf)& "<Br>" _
             & "<b>Plannen en organiseren</b><Br>" _
             & Join(Application.Transpose(Sheets("Blad1").Range("C29")), vbCrLf)

Kun je nog eens uitproberen.

SlootsJ · 9 okt 2019

Hi,

Hij geeft het volgende aan:

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    EmailManager = Range("EmailManager")
    EmailBCC = Range("EmailBCC")
    EmailCC = Range("EmailCC")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = "<b>Overzicht afspraken:</b><Br>" _
             & "<b>Communicatie:</b><Br>""" _
             & Join(Application.Transpose(Sheets("Blad1").Range("C16")), vbCrLf) & "<Br>" _
             & "<b>Plannen en organiseren</b><Br>" _
             & Join(Application.Transpose(Sheets("Blad1").Range("C29")), vbCrLf)
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

SlootsJ · 9 okt 2019

Aanvulling: Het bereik heb ik al aangepast naar de juiste sheetnummers en cellen, toch blijft de error zich herhalen.

loek010 · 9 okt 2019

De foutcode 9 subscript valt buiten bereik komt door dit

Code:

EmailManager = Range("EmailManager")
    EmailBCC = Range("EmailBCC")
    EmailCC = Range("EmailCC")

vervang het door deze code

Code:

EmailManager = Sheets("Instellingen").Range("EmailManager")
    EmailBCC = Sheets("Instellingen").Range("EmailBCC")
    EmailCC = Sheets("Instellingen").Range("EmailCC")

de code in de .HtmlBody is volgens mij ook niet geheel correct

loek010 · 9 okt 2019

Aangepaste Code dit werkt alleen als je de samengevoegde cellen C16 t/m C21 en C29 t/m C34 in blad Competenties opheft

Code:

Sub CommandButton2_Click()
    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Overzicht afspraken:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br>" & _
             .Range("C17") & "<Br>" & _
             .Range("C18") & "<Br>" & _
             .Range("C19") & "<Br>" & _
             .Range("C20") & "<Br>" & _
             .Range("C21") & "<Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br>" & _
             .Range("C30") & "<Br>" & _
             .Range("C31") & "<Br>" & _
             .Range("C32") & "<Br>" & _
             .Range("C33") & "<Br>" & _
             .Range("C34")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Zie afbeelding :

SlootsJ · 10 okt 2019

loek010 zei:

Aangepaste Code dit werkt alleen als je de samengevoegde cellen C16 t/m C21 en C29 t/m C34 in blad Competenties opheft

Code:

Sub CommandButton2_Click()
    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Overzicht afspraken:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br>" & _
             .Range("C17") & "<Br>" & _
             .Range("C18") & "<Br>" & _
             .Range("C19") & "<Br>" & _
             .Range("C20") & "<Br>" & _
             .Range("C21") & "<Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br>" & _
             .Range("C30") & "<Br>" & _
             .Range("C31") & "<Br>" & _
             .Range("C32") & "<Br>" & _
             .Range("C33") & "<Br>" & _
             .Range("C34")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Zie afbeelding :

Bekijk bijlage 341082

Excellent (pun intended), de code werkt nu naar behoren.
Toch nog 1 vraagje, stel ik wil uit het tabblad 'resultaatgebieden' de afspraken toevoegen, hoe krijg ik die er dan bij in?

SlootsJ · 10 okt 2019

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Comptetenties:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br><Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br><Br>" & _
             "<b>Initiatief:</b><Br>" & _
             .Range("C45") & "<Br><Br>" & _
             "<b>Coachen/Samenwerken:</b><Br>" & _
             .Range("C61")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Dit werkt.

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Comptetenties:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br><Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br><Br>" & _
             "<b>Initiatief:</b><Br>" & _
             .Range("C45") & "<Br><Br>" & _
             "<b>Coachen/Samenwerken:</b><Br>" & _
             .Range("C61")
             
    With Sheets("Resultaatgebieden")
             "<b>Resultaatgebieden:</b><Br><Br>" & _
             "<b>Acquisitie MTD</b><Br>" & _
             .Range("D9")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Dit niet.

Haije · 10 okt 2019

mist daar niet:

StrBody=

SlootsJ · 10 okt 2019

Haije zei:
mist daar niet:

StrBody=

Code:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Comptetenties:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br><Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br><Br>" & _
             "<b>Initiatief:</b><Br>" & _
             .Range("C45") & "<Br><Br>" & _
             "<b>Coachen/Samenwerken:</b><Br>" & _
             .Range("C61")
    End With
    
    With Sheets("Resultaatgebieden")
    StrBody = "<b>Resultaatgebieden:</b><Br><Br>" & _
             "<b>Acquisitie MTD</b><Br>" & _
             .Range("D9")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Bedankt voor je antwoord, nu krijg ik de melding 'fout 9 tijdens uitvoering: subscript buiten bereik'.

loek010 · 10 okt 2019

De foutmelding komt van With Sheets("Resultaatgebieden") in je tabblad naam staat een spatie achter "Resultaatgebieden "
dus zet een spatie achter Sheets("Resultaatgebiedenspatie")

indien je ook een ander tabblad in de mail wilt doe het dan zo :

Code:

Sub Mail()
   Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Overzicht afspraken:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br><Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br><Br>" & _
             "<b>Initiatief:</b><Br>" & _
             .Range("C45") & "<Br><Br>" & _
             "<b>Coachen/Samenwerken:</b><Br>" & _
             .Range("C61") & "<Br><Br>" & _
             "<b>Resultaatgebieden:</b><Br><Br>" & _
             "<b>Acquisitie MTD</b><Br>" & _
             Sheets("Resultaatgebieden ").Range("D9")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

SlootsJ · 10 okt 2019

loek010 zei:

De foutmelding komt van With Sheets("Resultaatgebieden") in je tabblad naam staat een spatie achter "Resultaatgebieden "
dus zet een spatie achter Sheets("Resultaatgebiedenspatie")

indien je ook een ander tabblad in de mail wilt doe het dan zo :

Code:

Sub Mail()
   Dim EmailManager As String
    Dim EmailCC As String
    Dim EmailBCC As String
    
    With Sheets("Instellingen")
    EmailManager = .Range("EmailManager")
    EmailBCC = .Range("EmailBCC")
    EmailCC = .Range("EmailCC")
    End With
    
    With Sheets("Competenties")
    StrBody = "<b>Overzicht afspraken:</b><Br><Br>" & _
             "<b>Communicatie:</b><Br>" & _
             .Range("C16") & "<Br><Br>" & _
             "<b>Plannen en organiseren:</b><Br>" & _
             .Range("C29") & "<Br><Br>" & _
             "<b>Initiatief:</b><Br>" & _
             .Range("C45") & "<Br><Br>" & _
             "<b>Coachen/Samenwerken:</b><Br>" & _
             .Range("C61") & "<Br><Br>" & _
             "<b>Resultaatgebieden:</b><Br><Br>" & _
             "<b>Acquisitie MTD</b><Br>" & _
             Sheets("Resultaatgebieden ").Range("D9")
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = EmailManager
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = "GC  Update per: " & Date & " van: " & Sheets("Competenties").Range("C2")
        .Attachments.Add ActiveWorkbook.FullName
        .htmlbody = StrBody
        .Display    'Send
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Heel scherp! En bedankt voor de tip.

Code .body in sendmail + opmaak

SlootsJ

Gebruiker

Bijlagen

OctaFish

Verenigingslid

SlootsJ

Gebruiker

OctaFish

Verenigingslid

SlootsJ

Gebruiker

SlootsJ

Gebruiker

loek010

Gebruiker

loek010

Gebruiker

SlootsJ

Gebruiker

SlootsJ

Gebruiker

Bijlagen

Haije

Terugkerende gebruiker

SlootsJ

Gebruiker

loek010

Gebruiker

SlootsJ

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy