Email/range in e-mail

[Spockies]

Mijn vraag
Met behulp van https://www.rondebruin.nl/win/s1/outlook/bmail2.htm heb ik het voor elkaar dat wanneer er op de verzend bestselling button wordt geklikt er in de body van een email de rijen worden gekopierd uit het excel
Hierin staan ook extra gegevens zoals wat we nog op voorraad hebben, dit heb ik aan kunnen passen zodat allen de benodigde gegevens worden gekopierd.
In dit voorraad beheer blad maak ik gebruik van minimum en maximum voorraad, zodra het onder het minimum komt dan wordt dit aangegeven hiervoor gebruik ik =IFERROR(IF([@HOEVEELHEID]<=[@MINIMUM];1;0);0)
Wat ik graag zou willen bereiken is dat als dit true is dat juist alleen deze rij gekopierd word naar de e-mail body
Nu heb ik geprobeerd om bij "Set rng = Range("B4:B12, C4:C12, K4:K12") "een if then stament te gebruiken maar krijg het niet werkend
Is er een excel guru die me kan helpen ?

code:

Private Sub CommandButton1_Click()
Dim rng As Range
Dim Outlook As Object
Dim OutlookMail As Object
Dim StrBody As String
Set rng = Nothing
On Error Resume Next
Set rng = Range("B4:B12, C4:C12, K4:K12")
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Not a range or protected sheet" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set Outlook = CreateObject("Outlook.Application")
Set OutlookMail = Outlook.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Bestelling"
StrBody = "Hallo " & "<br>" & _
              "Bij deze wilde ik de volgende bestelling plaatsen" & "<br>" & _
              "Met vriendelijke groet" & "<br><br><br>"
.HTMLBody = StrBody & RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutlookMail = Nothing
Set Outlook = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim obj As Object
Dim txtstr As Object
Dim File As String
Dim WB As Workbook
File = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set WB = Workbooks.Add(1)
With WB.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
With WB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=File, _
Sheet:=WB.Sheets(1).Name, _
Source:=WB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set obj = CreateObject("Scripting.FileSystemObject")
Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
RangetoHTML = txtstr.readall
txtstr.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
WB.Close savechanges:=False
Kill File
Set txtstr = Nothing
Set obj = Nothing
Set WB = Nothing
End Function

[dixet]

Het makkelijkst is met Rng.Autofilter je bereik te filteren op de waarde True in die kolom.
Vervolgens kopieer je alleen de zichtbare cellen met

code:

Rng.SpecialCells(xlCellTypeVisible).Copy

[Spockies]

Bedankt voor je antwoord dixet.
Ik heb over de gehele kolom een filter gezet.
en heb in plaats van

code:

Rng.SpecialCells(xlCellTypeVisible).Copy

code:

Selection.SpecialCells(xlCellTypeVisible)

gebruikt
Dit omdat er in hetzelfde blad meerdere leveranciers staan.
Nu zit ik allen met het probleem dat van alle rijen de geselecteerde kolommen gekopierd worden naar de
Is er een mogelijkheid om te zorgen dat er allen de aangeven range wordt gekopierd naar de email

Zoals in het voorbeeld te zien is de kolom leverancier, en locatie hoeven er helemaal niet bij

[ Voor 5% gewijzigd door Spockies op 15-05-2023 13:59 ]

[dixet]

Waarom ga je over naar Selection in plaats van je Rng naar de juiste cellten te laten verwijzen? En wat is op dat moment je Selection? Als je geen .Select() in je code doet is je Selection() maar net welke cellen je op dat moment hebt geselecteerd.

Aangezien je nu toch al met filters werkt kan je toch ook filteren op de leverancier die je wilt? Dan kan je de bestaande Rng variabele blijven gebruiken die je gewenste kolommen bevat

PS iemand taggen of quoten is wel handig als je ze noemt, dan krijgt diegene namelijk een notificatie dat er een vervolgvraag is

[ Voor 14% gewijzigd door dixet op 17-05-2023 11:38 ]

[F_J_K]

En dan helemaal afstappen van copy en paste: roep expliciet de juiste cellen aan. cells (i,j).value = cells(k,l).value. Dan heb je nooit problemen met bereik-formats etc.

Terzijde: haal meteen On Error Resume Next en On Error GoTo 0 er uit. Ga geen bestelling doen als er een error is. Stop en laat een mens meekijken. Die regel hoort niet thuis in enige code.