Wie kan mij helpen met het volgende?
Ik een Userform gemaakt met een keuzelijst die alle tabbladen herneemt. De button die ik gemaakt heb, met er voor zorgen, dat ik uit de keuzelijst een tabblad kan selecteren en die vervolgens in pdf kan verzenden via mail. De macro die ik geschreven heb laat enkel toe, dat ik de enkel het huidige tabblad kan versturen. Hieronder vinden jullie de reeds geschreven macro. Ik vermoed, dat dit zou moeten gebeuren via iloop?
Met dank voor jullie reactie
Private Sub Sendpdfbymail_Click()
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
TempFilePath = Environ$("temp") & "D:\Documents\Rijtijden Bus"
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
FileFullPath = "D:\Documents\Rijtijden Bus" & TempFileName
On Error GoTo err
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = "xxxxxx@xxxxxxxxx"
.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
Kill FileFullPath
Set NewMail = Nothing
Set OlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox ("Email Succesvol verstuurd")
Exit Sub
err:
MsgBox err.Description
End Sub
Ik een Userform gemaakt met een keuzelijst die alle tabbladen herneemt. De button die ik gemaakt heb, met er voor zorgen, dat ik uit de keuzelijst een tabblad kan selecteren en die vervolgens in pdf kan verzenden via mail. De macro die ik geschreven heb laat enkel toe, dat ik de enkel het huidige tabblad kan versturen. Hieronder vinden jullie de reeds geschreven macro. Ik vermoed, dat dit zou moeten gebeuren via iloop?
Met dank voor jullie reactie
Private Sub Sendpdfbymail_Click()
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
TempFilePath = Environ$("temp") & "D:\Documents\Rijtijden Bus"
TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
FileFullPath = "D:\Documents\Rijtijden Bus" & TempFileName
On Error GoTo err
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
On Error Resume Next
With NewMail
.To = "xxxxxx@xxxxxxxxx"
.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
Kill FileFullPath
Set NewMail = Nothing
Set OlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox ("Email Succesvol verstuurd")
Exit Sub
err:
MsgBox err.Description
End Sub