Mijn vraag:
Gebruikte software Excel 2016
Een tabblad in pdf versturen per mail door middel van een Listbox.
Tot nu toe heb ik twee buttons gemaakt, waarvan de eerste (Private Sub CmdPrintPDF_Click goed werkt. De button Private Sub Sendpdfbymail_Click() werkt ook maar alleen als ik op het juiste tabblad sta en dus niet met de keuzelijst. Het zou handig zijn, mocht dit ook kunnen via de Listbox.
Wie kan mij hierbij helpen?
-------------------------------------------------------------------------------------------------------------------------------------------------
Relevante software en hardware die ik gebruik
Gebruikte software Excel 2016
-------------------------------------------------------------------------------------------------------------------------------------------------
Wat ik al gevonden of geprobeerd heb
-------------------------------------------------------------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------------------------------------------------
Gebruikte software Excel 2016
Een tabblad in pdf versturen per mail door middel van een Listbox.
Tot nu toe heb ik twee buttons gemaakt, waarvan de eerste (Private Sub CmdPrintPDF_Click goed werkt. De button Private Sub Sendpdfbymail_Click() werkt ook maar alleen als ik op het juiste tabblad sta en dus niet met de keuzelijst. Het zou handig zijn, mocht dit ook kunnen via de Listbox.
Wie kan mij hierbij helpen?
-------------------------------------------------------------------------------------------------------------------------------------------------
Relevante software en hardware die ik gebruik
Gebruikte software Excel 2016
-------------------------------------------------------------------------------------------------------------------------------------------------
Wat ik al gevonden of geprobeerd heb
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
| Private Sub CmdPrintPDF_Click()
Dim iloop As Integer
Dim ftst As Variant
ftst = Sheets("Rijtijden Jan").Range("A1").Value
For iloop = 1 To ListBox1.ListCount
If ListBox1.Selected(iloop - 1) = True Then
Sheets(ListBox1.List(iloop - 1, 0)).ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
ftst & ListBox1.List(iloop - 1, 0), Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=True
ListBox1.Selected(iloop - 1) = False
End If
Next
End Sub |
-------------------------------------------------------------------------------------------------------------------------------------------------
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
| Private Sub Sendpdfbymail_Click()
'Do not forget to change the email ID
'before running this code
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim FileFullPath As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.
TempFilePath = Environ$("temp") & "D:\Documents\Rijtijden Bus"
' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
'Complete path of the file where it is saved
FileFullPath = "D:\Documents\Rijtijden Bus" & TempFileName
'Now Export the Activessheet as PDF with the given File Name and path
On Error GoTo err
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
'Now open a new mail
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = "xxxxxxxxxxx@xxxxxxxxxxx"
.CC = ""
.BCC = ""
.Subject = "Prestatieblad"
.Body = ""
.Attachments.Add FileFullPath '--- full path of the pdf where it is saved
.Display 'or use .Send to show you the email before sending it.
End With
On Error GoTo 0
'Since mail has been sent with the attachment
'Now delete the pdf file from the temp folder
Kill FileFullPath
'set nothing to the objects created
Set NewMail = Nothing
Set OlApp = Nothing
'Now set the application properties back to true
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox ("Email Succesvol verstuurd")
Exit Sub
err:
MsgBox err.Description
End Sub |
-------------------------------------------------------------------------------------------------------------------------------------------------