auto email na opslaan pdf

[wjpc]

Goede avond

is er mischien iemand die een macro code weet voor het volgende

de onderstaande macro werkt perfect.
er komt een popup of je het zeker weet
en na afloop een popup dat het gelukt is

nou zou ik graag in de laatste popup de optie krijgen met de vraag
wil deze woning ook emailen.
zodra je ja klikt wil ik graag dat hij het pdfje per email stuur in naar vooraf ingestelde email adres

endan een popup geef dat de email verzonden is

mvg wilfred

Private Sub CommandButton1_Click()



If MsgBox("Wil Je Deze Woning Opslaan?", vbQuestion + vbYesNo) = vbYes Then
If lAnswer = vbYes Then

End If
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd

Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String


MyName = Range("b6").Value & "" & Range("a2").Value & "" & Range("g5").Value
'/// Change the output file name here! ///
sPDFName = MyName & ".xls"
'"testPDF.pdf"
sPDFPath = "e:\test2 "
'ActiveWorkbook.Path & Application.PathSeparator

'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
MsgBox (" Woning Is Opgeslagen!")
End If
End Sub

 

[Wigi]

De site van Ken Puls had je al gevonden, nu die van Ron De Bruin nog en je bent klaar.

www.rondebruin.nl

Wigi

 

[wjpc]

de site van ron de bruin heb ik ook bekeken werkt ook perfect
er staat ook iets voor 2007 maar ik werk met 2003 kan niet over naar 2007

krijg het niet voorelkaar dat hij het pdf mailt die hij net heb aangemaakt
met de code van ron mailt hij het excel bestand in xls

mvg wilfred

 

[Logistiek]

ik heb de onderstaande code erbij staan (jouw code)

'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm
.Subject = "zelf een keuze maken"
.To = "vul hier een e-mail ades in"
.CC = ""
.Bcc = ""
.body = "hier kan je eventueel tekst mee geven " & vbCrLf & vbCrLf
.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf")
.Display '.Send

 

[wjpc]

waar zet ik de code neer
heb hem nu los onder een knop
en krijg dan de volgende fout melding

.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf")

 

[Logistiek]

Private Sub CommandButton1_Click()



If MsgBox("Wil Je Deze Woning Opslaan?", vbQuestion + vbYesNo) = vbYes Then
If lAnswer = vbYes Then

End If
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd

Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String


MyName = Range("b6").Value & "" & Range("a2").Value & "" & Range("g5").Value
'/// Change the output file name here! ///
sPDFName = MyName & ".xls"
'"testPDF.pdf"
sPDFPath = "e:\test2 "
'ActiveWorkbook.Path & Application.PathSeparator

'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")

With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
dit zou moeten werken
'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm
.Subject = "zelf een keuze maken"
.To = "vul hier een e-mail ades in"
.CC = ""
.Bcc = ""
.body = "hier kan je eventueel tekst mee geven " & vbCrLf & vbCrLf
.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf")
.Display '.Send
End With

End Sub

 

[wjpc]

hij kan het pad niet vinden
maar zoals ik kijk inde deze regel:
.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf")

zoekt hij naar een xls bestand en die bestaat niet

mvg wilfred

 

[Logistiek]

in de vorige code zat een klein foutje dit is aangepast in de bijlage

 

[wjpc]

mijn dank is groot

ik heb hier al wat uurtjes mee zitten prutsen


nu kan ik eindelijk verder


mvg wilfred

 

[Logistiek]

graag gedaan, wil je de vraag dan op opgelost zetten (rechts onderin dit scherm)