• 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.

Ieder tabblad uit een excel werkboek naar een andere afzender mailen als PDF

Status
Niet open voor verdere reacties.
P

Pat76rick

Gebruiker
Lid geworden
2 aug 2019
Berichten
40
Goedemiddag,

Ik ben mij wat aan het verdiepen om mijn werkzaamheden te vereenvoudigen mbv een macro's in een Excel. Ik ben nogal behoorlijk onervaren hiermee maar wil het mij graag eigen gaan maken!

Ik heb 15 verschillende tabbladen in een excel werkblad zitten welke ik dagelijks verstuur naar verschillende klanten als PDF. Ieder tabblad vertegenwoordigd een andere organisatie en de daarbij behorende email adressen.
Ik heb voor ieder tabblad inmiddels een macro aangemaakt met de onderstaande gegevens.

Private Sub CommandButton1_Click()
Dim Bestand As String
Dim OutApp As Object
Dim OutMail As Object

Bestand = Environ("TEMP") & "" & ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Bestand

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "klant@email.nl"
.CC = ""
.BCC = ""
.Subject = "TEST"
.Attachments.Add Bestand
.Send
End With
Kill Bestand
End Sub



  1. Ik heb geprobeerd een begeleidende tekst erbij te schrijven over meerdere regels maar dat lukt niet.
  2. Ik zou graag in het onderwerp van de email de automatisch huidige datum erbij willen vermelden (bv TEST 02-08-2019)
  3. Is het versturen van meerdere tabbladen die als PDF moeten worden verstuurd dit nou de handigste oplossing of zijn kan dit handiger?

Heeft iemand wellicht handige tips om mij hier verder mee te helpen?

Groet, Patrick
 
Dat is op zich geen enkel probleem.
Plaats een voorbeeld bestandje, dan wordt het zo voor je gemaakt.
 
In de bijlage een voorbeeld van een lijst zoals ik deze verstuur.
Deze heb ik versimpeld en normaliter zijn er veel meer tabbladen.

Hieronder nogmaals de punten zoals ik eerder aangaf....

Ik heb geprobeerd een begeleidende tekst erbij te schrijven over meerdere regels maar dat lukt niet.
Ik zou graag in het onderwerp van de email de automatisch huidige datum erbij willen vermelden (bv TEST 02-08-2019)
Is het versturen van meerdere tabbladen die als PDF moeten worden verstuurd dit nou de handigste oplossing of zijn kan dit handiger?
Een handtekening automatisch invoegen bij ieder email bericht.
 

Bijlagen

Dank je wel! Ik ben alweer een heel stuk verder.
Ik probeer de formules nu in het originele bestand te copieren maar welke formule/vba code hanteer ik voor het inlezen van de email adressen.

KlantA@email.nl staat nu in ieder tabblad. Wat is de formule in de vba code zodat ik dit goed kan zetten in het originele document!
 
Ik heb geen formules gebruikt.
Het email adres staat gewoon in het werkblad van de betreffende klant.
Ik ha er vanuit dat je voorbeeld een relevant voorbeeld is.
 
Misschien zo?:rolleyes:

Zoals Ed al aangaf, in ieder tabblad van klant in dit voorbeeld het emailadres invullen in cel B8
 

Bijlagen

Goedemorgen heren,

Het voorbeeld wat ik had gemaild is wat verkleind verkort.

Ik heb nu nogmaals een voorbeeld ge upload zoals dat in werkelijkheid is. De layout is zonder logo, de excel formules en namen erbij zijn vanwege privacy ook gewist, klant a tm c zijn eigenlijk 25 tabs (klanten) maar 3 tabs als voorbeeld lijken mij voldoende, toch? Deze kan ik uiteraard zelf weer toevoegen.

@edmoor zoals jij de aanpassing had gemaakt is al een hele goede stap in de richting.
Is het mogelijk om de email adressen onder elkaar in te vullen zoals ik in het nieuwe voorbeeld heb aangegeven (maximaal 6)? Zo zou een collega altijd makkelijk een email adres toe kunnen voegen en of verwijderen.

@ad1957 De knop mail naar alle klanten is de kerst op de taart!

Wel zou ik de optie willen hebben om in ieder tabblad nog apart met een macro te kunnen versturen.
 

Bijlagen

Zo iets voor de knop "verzenden Mail" per Klant.
Staat onder de knop op blad Klanta.
Kijk wel nog even naar de aanvulling in de cellen L14:L19
 

Bijlagen

Volgens mij maakt dat niets uit.
Als je simone@klanta.nl;patric@klanta.nl etc in .To hebt staan krijgt toch ook iedereen een aparte mail??
Zal er eens naar kijken, maar ben bang dat dit iets is voor de ECHT knappe koppen hier op dit forum.
 
Laatst bewerkt:
Ik heb je blad gecombineerd met die van edmoor. Als ik de email adressen achter elkaar met simone@klanta.nl; patric;klanta.nl dan worden deze mail adressen in 1 mail verzonden! Het is een luxe probleem ;)
 
Zou zo snel geen oplossing weten, je loopt ook nog eens tegen het probleem van de aanhef aan "beste Simone," "beste Patric"
Misschien heb je geluk en kijkt Edmoor nog mee, die heeft hier waarschijnlijk wel een oplossing voor:thumb:
Zou voor mij leerzaam zijn.
 
Pat76rick zei:
Ik heb je blad gecombineerd met die van edmoor. Als ik de email adressen achter elkaar met simone@klanta.nl; patric;klanta.nl dan worden deze mail adressen in 1 mail verzonden! Het is een luxe probleem ;)
Klik om te vergroten...

Heb je dan wel nog een persoonlijke aanhef??
Wil je me het voorbeeldbestand eens doorsturen?
 
deze had ik nog voor het versturen van alle mails tegelijkertijd

Code: 
Sub VerzendenAlleMail()
Dim Bestand As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Sheet As Object
    

    
    
For Each Sheet In ThisWorkbook.Sheets


If Sheet.Name <> "Formuleblad" Then
    Sheet.Activate
    With ActiveSheet
       For i = 14 To 19
            If .Range("M" & i).Value <> "" Then
                Bestand = Environ("TEMP") & "\" & .Range("A7").Value & "  " & .Range("B7").Value & ".pdf"
                .ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Bestand
                
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                
                StrTo = .Range("M" & i)
                StrSubject = "PRIJSLIJST" & " " & "dd." & .Range("H7").Value
                StrBody = "Beste" & " " & .Range("L" & i).Value & "," & vbCrLf & vbCrLf & _
                        .Range("L26").Value & vbCrLf & _
                        .Range("L27").Value & vbCrLf & _
                        .Range("L28").Value & vbCrLf & _
                        .Range("L29").Value & vbCrLf & _
                        .Range("L30").Value & vbCrLf & _
                        .Range("L31").Value & vbCrLf & vbCrLf & _
                       "Met vriendelijke groet," & vbCrLf & vbCrLf & _
                       "Patric" 'of Range("B7").value
                
                
                
                With OutMail
                    .To = StrTo
                    .CC = ""
                    .BCC = ""
                    .Subject = StrSubject
                    .Body = StrBody
                    .Attachments.Add Bestand
                    .Display 'of .Send voor direct verzenden
                End With
                Kill Bestand
            Else
            End If
        Next i
    End With
End If
Next Sheet
    

Set OutApp = Nothing
Set OutMail = Nothing

Sheets("Formuleblad").Activate
    
End Sub
 
Hoi Ad,

De persoonlijke aanheft is in 1 gezamenlijke mail aangezien het van 1 organisatie is. Deze heb ik gemaakt in de tekst die vrij in te voeren is (k17:k23). "Beste Simone, Patrick..., Hierbij de prijslijst voor vandaag"

Voor het versturen van alle mails tegelijk. Waar moet ik deze dan plakken. In de tabblad "formuleblad" of moet dit ook nog in Module 1?



Public Sub EmailVersturen()
Dim Bestand As String
Dim Subject As String
Dim Signature As String
Dim LastRow As Long
Dim MailTo As String
Dim OutApp As Object
Dim OutMail As Object

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

MailTo = ActiveSheet.Range("K9")
Subject = "Preislijst TEST " & Format(Date, "dd-mm-yyyy")

Bestand = Environ("TEMP") & "" & ActiveSheet.Name & ".pdf"
Range("A1:H" & LastRow).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Bestand

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
Signature = .HTMLBody
.To = MailTo
.CC = ""
.BCC = ""
.Subject = Subject
.HTMLBody = RangetoHTML(Range("k17:k23")) & vbCrLf & Signature
.Attachments.Add Bestand
.Display '.Send
End With
Kill Bestand
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
 
@AD1957

Kijk eens of je deze code erin kan verwerken

Code: 
Dim cell As Range
Dim strto As String
For Each cell In ActiveSheet.Range("M14:M19")
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

om de emailadressen aan mekaar te plakken
 
Laatst bewerkt:
Patric: De code zet je onder de knop "verzenden mail naar alle klanten" in jouw voorbeeld3
je kunt de code natuurlijk ook in een module zetten en dan deze aanroepen.


Loek: Bedankt, ga eens kijken hoe ik deze code kan implementeren. Alleen maar leerzaam:thumb:
 
Onder het mom we zijn er bijna.....

Dit is wat ik toe nu toe heb staan in voorbeeld 5.

K17;K23 (geel gearceerd) Daar wil ik een persoonlijke tekst schrijven voor iedere klant apart. De aanhef zet ik daar ik in. Dat gaat volgens mij goed.

Nu kom ik alleen niet uit het voorblad met stamdata.....

De knop EMAIL ALLE KLANTEN zou als macro moeten werken dat alle aparte sheets zoals vermeld in het voorbeeld met 1 druk op de knop worden verstuurd.....wat doet ik niet goed?
 

Bijlagen

Als je de layout van de sheets blijft veranderen kom je er nooit uit.
kijk maar eens naar strTo, waar verwijst deze naar.?

Het gedeelte for i = 14 tot 19 kan er ook helemaal uit.
Gewoon eens rustig de code bekijken en aanpassen aan de nieuwe layout.
Succes, kom je er helemaal niet uit dan wil ik er vanavond of morgen eens naar kijken.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan