VBA celimport

[Jan Meyer]

Beste,

Ik ben bezig met een Excel sheet om automatisch een mail te sturen via een macro.

Het gaat om het automatiseren van automatische bestelmails als een minimum is bereikt, zie onderstaande afbeelding.



Ik heb onderstaande macro gemaakt maar krijg het inlezen van de inhoud direct in de code niet van elkaar, kunnen jullie mij erbij helpen?

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("I2"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Beste leverancier D2 " & vbNewLine & vbNewLine & _
"Ik zou graag artikel B2 met artikelnummer C2 bijbestelhoeveelheid H2 keer bij willen bestellen." & vbNewLine & _
"Met vriendelijke groet"
On Error Resume Next
With xOutMail
.To = "mailadres E2 "
.CC = ""
.BCC = ""
.Subject = "automatische order"
.Body = xMailBody
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub


Bedankt voor de responds,
Jan

[KabouterSuper]

Wat werkt er niet? Begin eens met debuggen (nadat je de "On Error Resume Next" hebt weggehaald natuurlijk).

Hoe roep je de macro overigens aan? De code "If Target.Cells.Count > 1 Then Exit Sub" vind ik ietswat schimmig.

[Lustucru]

Alle terechte opmerkingen over 'on error resume next' en 'gebruik geen code in produktie die je niet zelf snapt of is gemaakt door iemand die het snapt' daargelaten: de vraag lijkt te zijn hoe je de waarde uit een cel ophaalt.

Dus in plaats van "Beste leverancier D2", "Beste Houtbedrijf de Splinter" tenminste als in D2 'Houtbedrijf de Splinter' staat.

tldr:

code:

xMailBody = "Beste leverancier " & Range("D2") & vbNewLine & vbNewLine & _

etc.

[Jan Meyer]

Hoi KabouterSuper,

Dank voor de input.
debuggen heb ik al gedaan "if target... is alleen maar dat er geen ander getal gebruikt kan worden dan 0 of 1.

Ik heb alleen in vet ingeschreven wat de bedoeling is.

dus Beste leverancier D2 is geen code maar wat erin hoord.
Als ik Lustucru goed begrijp is het dus

xMailBody = "Beste" & Range("D2") & vbNewLine & vb NewLine & _

[g0tanks]

Jan Meyer schreef op vrijdag 7 januari 2022 @ 09:05:
debuggen heb ik al gedaan

Wat is dan de foutmelding die je krijgt? In welke regel gaat het mis? Dat is voor mij nog steeds niet duidelijk.

[Jan Meyer]

Het is gelukt en werkt perfect, Dank voor de input.

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("I2"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Beste " & Range("D2") & vbNewLine & vbNewLine & _
"Ik zou graag artikel " & Range("B2") & vbNewLine & _
"met artikelnummer " & Range("C2") & vbNewLine & _
Range("H2") & " keer willen bestellen" & vbNewLine & _
"Dit is een automatisch gegenereerde E-mail" & vbNewLine & vbNewLine & _
"Met vriendelijke groet," & vbNewLine & _
"Team ... B.v."
On Error Resume Next
With xOutMail
.To = Range("E2")
.CC = ""
.BCC = ""
.Subject = "automatische order"
.Body = xMailBody
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub