thst
Gebruiker
- Lid geworden
- 10 apr 2001
- Berichten
- 655
Hallo Allemaal,
Ik heb 3 regels if then else toegevoegd, en krijg nu dat die een end sub mist, en dan weer een end with, ik heb vanalles al geprobeerd, maar niet werken.
Angela
Ik heb 3 regels if then else toegevoegd, en krijg nu dat die een end sub mist, en dan weer een end with, ik heb vanalles al geprobeerd, maar niet werken.
Angela
Code:
Sub opslaan_en_mailen()
'If MsgBox("Loes weet je zeker dat de factuur goed is ?", vbQuestion + vbYesNo) = vbYes Then
'If lAnswer = vbYes Then Hoort bij MsgBox Loes....
'End If Hoort bij MsgBox Loes ....
'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("P29").Value & ""
'/// Change the output file name here! ///
sPDFName = MyName & ".xls"
'"testPDF.pdf"
sPDFPath = "E:\A2B4U\Opdrachten\2010\New\"
'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
If MsgBox("Factuur mailen ?", vbQuestion + vbYesNo) = vbYes Then
'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
'.Subject = "Bijgaand de factuur, en bevestiging aflevering."
.Subject = "Betreft rit: " & Range("O33").Value 'Plaats - Plaats
.To = Range("O32").Value & "" 'vul hier een mail adres in
.CC = ""
.Bcc = ""
'.Body = Range("P31").Value & Range("O31").Value & vbNewLine & vbNewLine & Range("P32").Value & vbNewLine & Range("P33").Value & vbNewLine & vbNewLine & Range("P34").Value & vbNewLine & Range("P35").Value & vbNewLine & vbNewLine & Range("P36").Value & vbNewLine & Range("P37").Value & vbNewLine & Range("P38").Value & vbNewLine & vbNewLine & Range("P39").Value & vbNewLine & Range("P40").Value
.Body = Replace([P31] & [O31] & "#" & "#" & [P32] & "#" & [P33] & "#" & "#" & [P34] & "#" & [P35] & "#" & "#" & _
[P36] & "#" & [P37] & "#" & [P38] & "#" & "#" & [P39] & "#" & [P40], "#", vbNewLine)
'[ad1].CurrentRegion.ClearContents
fn = Dir("E:\A2B4U\Opdrachten\2010\*.pdf")
Do While fn <> ""
myResult = myResult & fn & "|"
fn = Dir()
Loop
[ad1].Resize(UBound(Split(myResult, "|"))) = WorksheetFunction.Transpose(Split(myResult, "|"))
.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf") 'Factuur word gemaild. (0123456789.pdf)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
If Range("034") = 1 Then
.Attachments.Add sPDFPath & "\" & (Range("O35").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)
Else
If Range("036") = 1 Then
.Attachments.Add sPDFPath & "\" & (Range("O37").Value) 'Vrachtbrief word gemaild. (0123456789b.pdf)
Else
If Range("038") = 1 Then
.Attachments.Add sPDFPath & "\" & (Range("O39").Value) 'Vrachtbrief word gemaild. (0123456789p.pdf)
Else
'.Attachments.Add sPDFPath & "\" & (Range("O29").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)
.Display
'.Save
'.Send
End With
Else
Worksheets(6).Cells(11, 16) = 0
Application.Calculate
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"
Worksheets(6).Cells(11, 16) = 1
Application.Calculate
End If
'End If Hoort bij MsgBox Loes ....
End Sub
