Deel van de worksheet in de body van de mail

[HWV]

Beste,

Voor het verzenden van mijn worksheet in outlook gebruik ik de volgende code wat goed werkt.
Enkel nu zou ik in de body van de mail een deel van de sheet willen laten zien.

Ik heb verschillende voorbeelden die dat wel doen maar ik weet niet hoe ik deze moet integreren in deze code.

Kunt u mij hier mee helpen.

Het gaat hier in Worksheets("Orderbon") dat range B17 t/m R36 wordt mee gekopieerd in de body van de te zenden email, en dat de worksheet als bijlage mee gezonden gaat worden wat hij nu al doet.

Sub Mail_Every_Worksheet()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
 ReplaseVreemdeTekens
 
'Working in 97-2007
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String

Dim Klant
Set Klant = Worksheets("Orderbon").Range("G6")

Dim Plaatsnaam
Set Plaatsnaam = Worksheets("Orderbon").Range("G7")

Dim DebNr
Set DebNr = Worksheets("Orderbon").Range("D9")

Dim Formulier
Set Formulier = Worksheets("Orderbon").Range("F3")

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

'Toegevoegd 10-06-2013
Sheets(Split("Orderbon", "|")).Copy

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("P6").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = "" & Klant & " " & Plaatsnaam & " " _
                         & DebNr & " " _
                         & Format(Now, "dd-mmm-yy h mm")

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, _
                        FileFormat:=FileFormatNum
                On Error Resume Next
                '.SendMail sh.Range("P6").Value, "" & Klant & " " & Plaatsnaam & " " & DebNr & " " & Format(Now, "dd-mmm-yy h mm ss") & " - " & Formulier & ""
                .SendMail sh.Range("P6").Value, "" & Formulier & " - " & Klant & " " & Plaatsnaam & " " & DebNr & " " & Format(Now, "dd mmmm yyyy h:mm") & ""
                
               If [p7] = "" Then
               Else
                '.SendMail sh.Range("P7").Value, "CC_" & Klant & " " & Plaatsnaam & " " & DebNr & " " & Format(Now, "dd-mmm-yy h mm ss") & " - " & Formulier & ""
                .SendMail sh.Range("P7").Value, "CC_" & Formulier & " - " & Klant & " " & Plaatsnaam & " " & DebNr & " " & Format(Now, "dd mmmm yyyy h:mm") & ""
               
               End If
                On Error GoTo 0
                .Close SaveChanges:=False
            End With

        '    Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
        Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Alvast bedankt voor de aangeboden hulp

HWV

 

[HSV]

Bij het gebruik van 'Sendmail' kan je geen "body" toevoegen.
De methode heeft maar drie parameters.
Te weten: 'Recipients', 'Subject' en 'ReturnReciept'.
Je kan eens zoeken op "mailen via outlook".
Plenty voorbeelden.

 

[HWV]

Een stap verder

Beste,

Met behulp van twee scripts van SNB en die samengevoegd te hebben ben ik een flinke stap verder (bedankt SNB).
In de body en als bijlage.

Sub Save_Mail_Werkblad_Inhoud_in_de_Body()

Dim Naam
Set Naam = Worksheets("orderbon").Range("D10")

Dim Plaats
Set Plaats = Worksheets("orderbon").Range("F12")

Dim Debnummer
Set Debnummer = Worksheets("orderbon").Range("D9")

Dim Formulier
Set Formulier = Worksheets("orderbon").Range("F3")

Dim Vertegenwoordiger
Set Vertegenwoordiger = Worksheets("orderbon").Range("P4")
Dim Bestandsnaam
Set Bestandsnaam = Worksheets("orderbon").Range("N3")

 With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$15"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    ActiveWindow.DisplayGridlines = False
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.118110236220472)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .CenterHorizontally = True
        .CenterVertically = True
        .PrintComments = xlPrintNoComments
        .Orientation = xlLandscape
        .Draft = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    
 ReplaseVreemdeTekens
 
 c00 = "P:\Ingevulde bonnen\Offerte aanvragen\" & Bestandsnaam & "" & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
 c01 = ThisWorkbook.FileFormat

c03 = "<table border=0 bgcolor=#FFFFF0#>"

 sn = Sheets("Orderbon").Range("B16:R56") '.UsedRange
 For j = 1 To UBound(sn)

c03 = c03 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
 c03 = c03 & "</table><P></P><P></P>"

 ThisWorkbook.Sheets("Orderbon").Copy

 With ActiveWorkbook
.SaveAs c00, c01
 .Close False
End With

 With CreateObject("Outlook.Application").createitem(0)
 .To = [P6]
 .CC = [P7]
 .Subject = [N3]
 .attachments.Add c00
 .HTMLBody = c03
 .Send '.Display
End With

MsgBox "Beste " & Vertegenwoordiger & "," & vbCrLf & "" & vbCrLf & "Uw Offertebon voor de klant " & Naam & " is opgeslagen," & vbCrLf & "deze vind u terug in P:\Ingevulde bonnen\Offerte aanvragen" & vbCrLf & ""

BestandenSluiten

 End Sub

Hij kopieer het blad orderbon, achter dit blad zit nog wat code die ik eigenlijk niet mee wil nemen naar de kopie.
Is er een mogelijkheid dat we dit niet mee kopiëren .

Elke verbetering in de code is natuurlijk welkom.
Groet HWV

 

[HSV]

bv.

ThisWorkbook.Sheets(1).Copy
  Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs "c:\bestandenpad\testje", 51
  ActiveWorkbook.Close
Application.DisplayAlerts = True