• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Mail versturen via Outlook met Excel bijlage

Status
Niet open voor verdere reacties.
S

Siep26

Gebruiker
Lid geworden
15 sep 2017
Berichten
71
Ik heb een Excel bestand waar ik een mailfunctie wil inbouwen, zodat sheet 1 & 2 in één bestand per mail verstuurd kunnen worden naar de adressen die ik heb ingevuld bij Aan, CC of BCC. Dat Outlook een nieuwe mail opent sheet 1 en 2 toevoegt als bijlage en de mailadressen ook invult. Zodat ik in principe alleen nog op verzenden hoef te duwen. Daarbij wil ik dat ook nog het onderwerpveld automatisch wordt gevuld met de datum van vandaag. Plus een stukje standaard tekst.

Zie afbeelding hieronder. De zwarte vlakken moeten een knop voorstellen.

11qnxux.jpg


Bijgaand ook het Excel bestand.
 

Bijlagen

  • Verzenden test.xlsx
    10,5 KB · Weergaven: 47
Laatst bewerkt:
Openstaandepostenlijst is één woord, zonder spaties.
Voor het overige, zie bijlage.
 
Laatst bewerkt:
Behalve dan dat openstaande een bijvoeglijk naamwoord is, en het inderdaad een postenlijst is.
Oftewel een openstaande postenlijst
 
Omdat postenlijst één woord is moet je noodzakelijkerwijs het bijvoeglijk naamwoord er ook aan vastplakken.
Vergelijk: langeafstandsloper.
 
Timshel zei:
Openstaandepostenlijst is één woord, zonder spaties.
Voor het overige, zie bijlage.
Klik om te vergroten...

Beste Timshel,

Bedankt voor jou reactie en hulp!

Ik heb echter het verkeerde bestand in de openingspost gezet, dit heb ik nu aangepast. Zou je er nog eens naar willen kijken?

Ik ben al heel blij met jouw hulp. In de mail die outlook opent zie ik nu in het onderwerpveld Heden,8-3-2018. Ik zou graag daar zien dat hij de tekst overneemt die hij overneemt uit een cel die ik zelf kan bewerken + een cel waarin ik bijvoorbeeld een datum kan zetten. En is het mogelijk dat er een tekstveld komt dat ik in Excel kan bewerken en dat ook in t tekstveld bij de mail komt?

Verder noemt outlook het bestand 'openposten 8-3-2018'. Kan ik dit ook nog aanpassen?

Bijvoorbaat dank! Kan ik jou voor je hulp al een bedrag doneren?
 
Kijk zo eens.
Ik heb de code hier en daar voorzien van een korte toelichting. Probeer eerst zelf gewenste aanpassingen te maken.

Siep26 zei:
Bijvoorbaat dank! Kan ik jou voor je hulp al een bedrag doneren?
Klik om te vergroten...
Doneer wat mij betreft aan een goed doel, bijvoorbeeld 20 euro aan Artsen zonder Grenzen. :)
 

Bijlagen

  • Verzenden test.xlsm
    22,5 KB · Weergaven: 63
Laatst bewerkt:
Timshel zei:
Kijk zo eens.
Ik heb de code hier en daar voorzien van een korte toelichting. Probeer eerst zelf gewenste aanpassingen te maken.


Doneer wat mij betreft aan een goed doel, bijvoorbeeld 20 euro aan Artsen zonder Grenzen. :)
Klik om te vergroten...

Super bedankt!

Ik zie echter dat de bestandsnaam vast staat en dat deze niet uit een cel wordt gekopieerd. Ik heb zelf zitten *****n, maar krijg dat niet aangepast. Zou je me hiermee nog kunnen helpen? Indien mogelijk, dat de bestandsnaam uit twee cellen wordt uitgehaald (B1 en C1)

Verder heb ik je een prive bericht proberen te sturen, maar dat was niet mogelijk. Ik hoop dat de forumadministrator het doorzet naar jou!
 
Laatst bewerkt:
Wijzig de code in:
Code: 
Sub Meel()
    Dim sFile As String
    Dim Rng As Range
    
    sFile = ThisWorkbook.Path & "\" & [COLOR="#FF0000"]Range("J1")[/COLOR] & ".xlsx" 'Hier wordt de naam van het bestand gedefinieerd
    Sheets("draaitabel").Copy
    ActiveWorkbook.SaveAs sFile, 51
    ThisWorkbook.Sheets("export").Copy After:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Close True
    With CreateObject("Outlook.Application").CreateItem(0)
        'Aan
        Set Rng = Range("B3").Resize(, Cells(3, Columns.Count).End(xlToLeft).Column - 1)
        If Rng.Count > 1 Then
            .To = Join(Application.Transpose(Application.Transpose(Rng)), ";")
        Else
            .To = Rng.Value
        End If
        
        'CC en BCC
        If Range("B4") <> "" Then
            Set Rng = Range("B4").Resize(, Cells(4, Columns.Count).End(xlToLeft).Column - 1)
            If Rng.Count > 1 Then
                .CC = Join(Application.Transpose(Application.Transpose(Rng)), ";")
            Else
                .CC = Rng.Value
            End If
        End If
        
        If Range("B5") <> "" Then
            Set Rng = Range("B5").Resize(, Cells(5, Columns.Count).End(xlToLeft).Column - 1)
            If Rng.Count > 1 Then
                .BCC = Join(Application.Transpose(Application.Transpose(Rng)), ";")
            Else
                .BCC = Rng.Value
            End If
        End If
        
        [COLOR="#FF0000"].Subject = Range("B1") & ", " & Range("C1")[/COLOR] 'Onderwerp
        .Body = Join(Application.Transpose(Range("B7:B" & Cells(Rows.Count, 2).End(xlUp).Row)), vbCrLf) 'Mailtekst
        .Attachments.Add sFile
        .Display
    End With
    Kill sFile
End Sub
Toelichting: de bestandsnaam wordt in deze opzet uit cel J1 gehaald, het onderwerp van de mail uit B1 en C1. Tevens is de code iets vereenvoudigd en is er een bugje uitgehaald.
 
Of:
Code: 
Sub M_snb()
    Application.DisplayAlerts = 0
    c00 = ThisWorkbook.Path & "\open_posten " & Date & ".xlsx"
    sn = Cells(3, 1).CurrentRegion
    
    Sheets.Copy
    With ActiveWorkbook
        .Sheets("verzenden").Delete
        .SaveAs c00, 51
        .Close 0
    End With
    
    With CreateObject("Outlook.Application").CreateItem(0)
        .to = Join(Filter(Application.Index(sn, 1), "@"), ",")
        .cc = Join(Filter(Application.Index(sn, 2), "@"), ",")
        .bcc = Join(Filter(Application.Index(sn, 3), "@"), ",")
        .Subject = "Openstaande posten " & Date
        .body = Join([transpose(B7:B9)], vbLf)
        .Attachments.Add c00
        .send
    End With
End Sub

@Tim

Lange afstand is echt geen bijvoeglijk naamwoord.
'Openstaande posten' lijkt me in dit geval voldoende. De toevoeging lijst of overzicht is pleonastsich.
 
@Timshel ik kan je niet bereiken via een prive bericht, maar zou je post #3 willen verwijderen. Die bijlage is verkeerd. Bvd.

Ik heb een donatie gedaan trouwens!
 
Nog een extraatje. Is het ook mogelijk dat er ook nog een ander bestand wordt toegevoegd aan de mail? Dit bestand staat in een bepaalde map (en is het meest recent gewijzigde bestand).
 
Je kunt eenvoudigweg een .Attachments.Add-regeltje toevoegen, waarbij je in onderstaand voorbeeld natuurlijk even C:\Temp\Document.docx moet vervangen door het volledige pad + bestandsnaam van het bestand dat je wilt aanhechten:
Code: 
Sub Meel()
    Dim sFile As String
    Dim Rng As Range
    
    sFile = ThisWorkbook.Path & "\" & Range("J1") & ".xlsx" 'Hier wordt de naam van het bestand gedefinieerd
    Sheets("draaitabel").Copy
    ActiveWorkbook.SaveAs sFile, 51
    ThisWorkbook.Sheets("export").Copy After:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Close True
    With CreateObject("Outlook.Application").CreateItem(0)
        'Aan
        Set Rng = Range("B3").Resize(, Cells(3, Columns.Count).End(xlToLeft).Column - 1)
        If Rng.Count > 1 Then
            .To = Join(Application.Transpose(Application.Transpose(Rng)), ";")
        Else
            .To = Rng.Value
        End If
        
        'CC en BCC
        If Range("B4") <> "" Then
            Set Rng = Range("B4").Resize(, Cells(4, Columns.Count).End(xlToLeft).Column - 1)
            If Rng.Count > 1 Then
                .CC = Join(Application.Transpose(Application.Transpose(Rng)), ";")
            Else
                .CC = Rng.Value
            End If
        End If
        
        If Range("B5") <> "" Then
            Set Rng = Range("B5").Resize(, Cells(5, Columns.Count).End(xlToLeft).Column - 1)
            If Rng.Count > 1 Then
                .BCC = Join(Application.Transpose(Application.Transpose(Rng)), ";")
            Else
                .BCC = Rng.Value
            End If
        End If
        
        .Subject = Range("B1") & ", " & Range("C1") 'Onderwerp
        .Body = Join(Application.Transpose(Range("B7:B" & Cells(Rows.Count, 2).End(xlUp).Row)), vbCrLf) 'Mailtekst
        .Attachments.Add sFile
        [COLOR="#FF0000"].Attachments.Add "C:\Temp\Document.docx"[/COLOR]
        .Display
    End With
    Kill sFile
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan