Automatisch verzenden.

[gast0708]

Simpele vraag: Ik wil graag een automatische verzendactie. De onderstaande code geeft mij een "Outlook-verzend E-mail" venstertje. Maar ik wil dat deze code ook de "Verzend" button bedient en niet het venstertje laat staan zodat ik op verzenden moet drukken.
Ofwel: Wat is de code voor "automatisch verzenden" in dit geval?

Code:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngResponse As Long
Dim URL As String, strEmail As String, strSubject As String
If Left(Target.Address, 2) = "$D" Then
If Target.Value < Range("$E" & Right(Target.Address, 2)).Value Then
lngResponse = MsgBox("De voorraad is op. Nieuwe voorraad bestellen?", vbYesNo)
If lngResponse = vbYes Then
strEmail = Range("$H" & Right(Target.Address, 2)).Value
strSubject = "Nieuwe voorraad bestellen:%0D%0A%0D%0A" & Range("$F" & Right(Target.Address, 2)).Value & " " & Range("$B" & Right(Target.Address, 2)).Value & " "
strSubject = Application.WorksheetFunction.Substitute(strSubject, " ", "%20")
strURL = "mailto:" & strEmail & "?subject=" & "Bestelling" & "&body=" & strSubject
ShellExecute 0&, vbNullString, strURL, vbNullString, vbNullString, vbNormalFocus
End If
End If
End If
End Sub



Groetjes

PS: De code is VBA en afkomstig uit een Excel-worksheet!

 

[OctaFish]

Als je Outlook gebruikt, zou ik een Outlook sessie openen.

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    OutApp.Visible = True
    Set OutMail = OutApp.CreateItem(0)
	With OutMail
		.To = sEmailAdres
		.Subject = Sheets(sNieuwBlad).Range("O3")
		'Misschien een HTML document van maken?
		.HTMLBody = RangetoHTML(rng)
		'Of kale tekst?
''        .body = sBody
		.Attachments.Add sFileName
		.Display 
		'Of, als je gelijk wilt verzenden, onderstaande variant.
		'.Send
	End With

En als je de CODE tag gebruikt (knop #) ziet jouw code er ook fatsoenlijk leesbaar uit

 

[gast0708]

Zal eraan denken.

maar om even antwoord te geven... ik wilde graag voor mijn geplakte code een "automatische Verzend optie" .. als dat mag

Groetjes

 

[oeldere]

.Attachments.Add sFileName
		.Display 
		'Of, als je gelijk wilt verzenden, onderstaande variant.
		[COLOR="darkred"]'.Send[/COLOR]

ik denk dat octafish de oplossing al heeft aangereikt.

kies voor .Send (groene teken weghalen) en er zal automatisch worden verzonden.

test dit eens uit en laat je bevindingen eens weten.

 

[gast0708]

@ Oeldere & OctaFish

Het was juist mijn bedoeling om een send-functie "in te bouwen" in mijn code, omdat deze code de e-mail al helemaal in de juiste format zet en outlook tevoorschijn tovert.
Daarom wou ik graag hierin een zendfunctie als dat "werkt" .. i.p.v. van dat stukje extra outlook-script.


Groetjes Mich.

 

[Haaren101]

Ik maak gebruik van de code van Ron de Bruin. Werkt erg prettig

Ron (niet de Bruin)

 

[gast0708]

In onderstaande code staat de line Strurl = "mailto:" & strEmail & "?subject=" & "Bestelling" & "&body=" & strSubject.

Het stukje "&body=" & strSubject werkt prima om beide StrSubjects in een outlook mail te zetten mèt Linebreaks keurig onder elkaar.

maar bij .Body = strSubject werkt het Linebreak niet meer

Hoe koppel ik "&body=" & strSubject en .Body aan elkaar mét linebreaks??

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim lngResponse As Long
    Dim URL As String, strEmail As String, strSubject As String
    If Left(Target.Address, 2) = "$D" Then
        If Target.Value < Range("$E" & Right(Target.Address, 2)).Value Then
            lngResponse = MsgBox("De voorraad is op. Nieuwe voorraad bestellen?", vbYesNo)
            If lngResponse = vbYes Then
               strEmail = Range("$H" & Right(Target.Address, 2)).Value
                strSubject = "Nieuwe voorraad bestellen:vbNewLine" & Range("$F" & Right(Target.Address, 2)).Value & " " & Range("$B" & Right(Target.Address, 2)).Value & "Groetjes, De Knotsgekke Groenteboer!"
                strSubject = Application.WorksheetFunction.Substitute(strSubject, "", "")
                Strurl = "mailto:" & strEmail & "?subject=" & "Bestelling" & "&body=" & strSubject
       
    
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
        With OutMail
        .To = strEmail
        .CC = ""
        .BCC = ""
        .Subject = "Bestellingsherinnering"
        .Body = strSubject
        .Send
        
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End If
                End If
                End If
End Sub