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

Opgelost Mail versturen met pdf

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.
N

niekie73

Gebruiker
Lid geworden
26 nov 2023
Berichten
42
Macro voor active worksheet versturen als pdf heb ik gevonden en werkend.


Maar in bijgevoegd bestand zou ik graag tabblab mail gebruiken want daar staat de standaard tekst en info op.

Is het dan ook mogelijk om bijv een ander tabblad uit dit bestand mee te sturen als PDF.
Ik hoop dat mijn vraag duidelijk is.
 

Bijlagen

Dat kan bijvoorbeeld zo:
Code: 
Sub Mailen_rangen_excel()
    Dim OutApp As Object
    Dim OutMail As Object
           
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    Application.ScreenUpdating = False
    With OutMail
        .To = Sheets("Mail_NOC").Range("B5")
        .CC = Sheets("Mail_NOC").Range("B6")
        .BCC = ""
        .Subject = Sheets("Mail_NOC").Range("B3")
        .HTMLBody = RangetoHTML(Sheets("Mail_NOC").Range("H2:P25"))
        .Display
    End With
    Application.ScreenUpdating = True
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Laatst bewerkt:
Bedankt voor je reactie, maar is het nu ook mogelijk om bijv tabblad broken EIN als pdf mee te sturen.
 
Jazeker:
Code: 
Sub Mailen_rangen_excel()
    Dim OutApp As Object
    Dim OutMail As Object
          
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    PDF = Replace(ThisWorkbook.FullName, ".xlsm", ".pdf")
    Sheets("C-Broken EIN").ExportAsFixedFormat 0, PDF
 
    Application.ScreenUpdating = False
    With OutMail
        .To = Sheets("Mail_NOC").Range("B5")
        .CC = Sheets("Mail_NOC").Range("B6")
        .Subject = Sheets("Mail_NOC").Range("B3")
        .HTMLBody = RangetoHTML(Sheets("Mail_NOC").Range("H2:P25"))
        .Attachments.Add PDF
        .Display
    End With
    Application.ScreenUpdating = True
   
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Laatst bewerkt:
jij bent echt geweldig

Nog 1 verzoekje indien mogelijk, hij neemt nu naam van het excel bestand als bijlage kan dit ook
met de naam van het tabblad
 
Dat kan.
Voor het active werkblad doe je dat zo:
Code: 
PDF = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"
Dat ActiveSheet.Name kan je ook wijzigen in bijvoorbeeld "niekie73"
Dan wel tussen aanhalingstekens zoals ik deed.
 
oke thanks dit kan alleen voor active sheet en niet voor bijv een andere sheet dat ik daar de naam van invul.
 
Heb je wel gelezen wat er onder de code staat?
 
Code: 
Sub Mailen_rangen_excel()
    Dim sh As Worksheet: Set sh = Sheets("Mail_NOC")
    Dim wsPDF As Worksheet: Set wsPDF = Sheets("C-Broken EIN")
   
    Application.ScreenUpdating = False
    PDFpath = ThisWorkbook.Path & Application.PathSeparator & wsPDF.Name
    wsPDF.ExportAsFixedFormat 0, PDFpath
   
    On Error Resume Next
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = sh.Range("B5")
        .CC = sh.Range("B6")
        .BCC = ""
        .Subject = sh.Range("B3")
        .HTMLBody = RangetoHTML(sh.Range("H2:P25"))
        .Attachments.Add PDFpath & ".pdf"
        .Display
    End With
    Application.ScreenUpdating = True
End Sub
 
Mijn oprechte excuses had snel gekeken voordat ik ging werken. Snel maar dus niet goed im sorry
 
Geen probleem :)
 
Ik heb het nu allemaal iets rustiger bekeken, in de testfile werkt alles super. So thanks all

Wil ik de code gebruiken in mijn orginele file krijg ik de volgende melding
Complileerfout: sub of function is niet gedefineerd
.HTMLBody = RangetoHTML(Sheets("Mail_NOC").Range("H2:P25"))

Of compileerfout:
Sub of function is niet gedefinieerd
.HTMLBody = RangetoHTML(Sheets("Mail_NOC").Range("H2:P25"))

Dubbelzinnige naam heb ik ook al een keer gehad
Ik zal wel iets helemaal over het hoofd zien, maar ik weet niet wat misschien dat ik dit weekend er eens
rustig voor ga zitten.
 
Laatst bewerkt:
Je moet natuurlijk wel de code van die RangeToHTML functie ook in je originele bestand zetten.
Die staat ook in je voorbeeld document.
 
Ja ik zie iets helemaal over het hoofd, test bestand was een kopie van het orginele bestand vandaar dat ik dacht dat ik de makro zo over kon zetten. Moet er dit weekend echt eens rustig voor gaan zitten want nu kom ik er niet uit.

Ik wil jullie allemaal vriendelijk bedanken voor jullie geduld en begrip, en hulp.
Ik moet er echt rustig voor gaan zitten
 
Dit is de code die je mist en kan je zonder enige wijziging in je originele document plakken:
Code: 
Function RangetoHTML(rng As Range)
    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 workbook to receive the data.
    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 an .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 the RangetoHTML subroutine.
    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.
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
als het werkt ben jij een held en scheelt mij veel zoek werk.

Uiteraard werkt het gewoon, bewijst maar weer dat je als beginneling niet alles even tussendoor
moet doen. Maar er rustig voor moet gaan zitten, had nu gewoon ook 2x de code erin staan. Raar he dat ik dan een foutmelding krijg :-p nogmaals mijn hartelijke dank.
 
Laatst bewerkt:
Nog 1 klein dingetje nu slaat hij het PDF op. Maar dat hoeft eigenlijk niet ik weet dat ik kill en delete erin moet zetten. En heb al wat dingen geprobeerd maar het lukt niet.
 
Je kan een het einde gewoon dit zetten:
Code: 
Kill PDF
 
Toch nog een vraagje, ik zou het evt ook alleen als excel tabblad mee willen sturen.
dacht het zelf even aan te passen maar je raad het al, dat lukt me weer eens niet.
 
Dat kan niet.
Je kan wel een nieuw document met alleen dat tabblad versturen.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan