Ik heb dankzij dit forum in excel een formulier gemaakt. Bij het opslaan worden de gegevens in een werkblad weggeschreven en krijgt de persoon die de meldingen moet afhandelen een melding via de mail. Nu heb ik een code toegevoegd frmMelding.PrintForm
De gegevens worden opgeslagen en het formulier wordt geprint via de standaard printer. Ik wil echter dat het formulier niet wordt geprint maar als pdf wordt verstuurd via de mail. Wie heeft hiervoor de code?
Private Sub cmdOpslaan_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("totaal")
'''find first empty row in database
''iRow = ws.Cells(Rows.Count, 1)_
''.End(xlUp).Offset(1, 0).Row
'resived code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'controleer contact
If Trim(Me.txtContact.Value) = "" Then
Me.txtContact.SetFocus
MsgBox "Vul een contactpersoon in"
Exit Sub
End If
'controleer telefoon
If Trim(Me.txtTelefoon.Value) = "" Then
Me.txtTelefoon.SetFocus
MsgBox "Vul een telefoonnummer in"
Exit Sub
End If
'copy the data to the database
frmMelding.PrintForm
ws.Cells(iRow, 1).Value = Me.txtVolgnummer.Value
ws.Cells(iRow, 2).Value = DateValue(txtDatum.Value)
ws.Cells(iRow, 3).Value = Me.txtBedrijf.Value
ws.Cells(iRow, 4).Value = Me.txtMelder.Value
ws.Cells(iRow, 5).Value = Me.txtContact.Value
ws.Cells(iRow, 6).Value = Me.txtTelefoon.Value
ws.Cells(iRow, 7).Value = Me.txtOnderwerp.Value
ws.Cells(iRow, 8).Value = Me.txtUrgentie.Value
ws.Cells(iRow, 9).Value = Me.CoBAangenomen.Value
ws.Cells(iRow, 29).Value = Me.txtVestiging.Value
ws.Cells(iRow, 30).Value = Me.txtAdres.Value
ws.Cells(iRow, 31).Value = Me.txtPost.Value
ws.Cells(iRow, 32).Value = Me.txtOmschrijving.Value
'clear the data
Me.txtVolgnummer.Value = ""
Me.txtDatum.Value = ""
Me.txtBedrijf.Value = ""
Me.txtVestiging.Value = ""
Me.txtAdres.Value = ""
Me.txtPost.Value = ""
Me.txtMelder.Value = ""
Me.txtContact.Value = ""
Me.txtTelefoon.Value = ""
Me.txtOnderwerp.Value = ""
Me.txtOmschrijving.Value = ""
Me.txtUrgentie.Value = ""
Me.CoBAangenomen.Value = ""
Me.txtDatum.SetFocus
Unload Me
Dim objOutlk As Object
Dim objMail As Object
Dim strMsg As String
Set objOutlk = CreateObject("Outlook.Application")
Set objMail = objOutlk.createitem(olMailItem)
Set MyAttachements = objMail.Attachments
With objMail 'To will support more than one email address as shown below
.To = "adres@provider.nl"
.cc = "adres@provider.nl"
.Subject = "Er is een nieuwe testmelding" 'Subject
.body = strMsg 'Body
.Send 'Send mailnt
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Quit
End Sub
De gegevens worden opgeslagen en het formulier wordt geprint via de standaard printer. Ik wil echter dat het formulier niet wordt geprint maar als pdf wordt verstuurd via de mail. Wie heeft hiervoor de code?
Private Sub cmdOpslaan_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("totaal")
'''find first empty row in database
''iRow = ws.Cells(Rows.Count, 1)_
''.End(xlUp).Offset(1, 0).Row
'resived code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'controleer contact
If Trim(Me.txtContact.Value) = "" Then
Me.txtContact.SetFocus
MsgBox "Vul een contactpersoon in"
Exit Sub
End If
'controleer telefoon
If Trim(Me.txtTelefoon.Value) = "" Then
Me.txtTelefoon.SetFocus
MsgBox "Vul een telefoonnummer in"
Exit Sub
End If
'copy the data to the database
frmMelding.PrintForm
ws.Cells(iRow, 1).Value = Me.txtVolgnummer.Value
ws.Cells(iRow, 2).Value = DateValue(txtDatum.Value)
ws.Cells(iRow, 3).Value = Me.txtBedrijf.Value
ws.Cells(iRow, 4).Value = Me.txtMelder.Value
ws.Cells(iRow, 5).Value = Me.txtContact.Value
ws.Cells(iRow, 6).Value = Me.txtTelefoon.Value
ws.Cells(iRow, 7).Value = Me.txtOnderwerp.Value
ws.Cells(iRow, 8).Value = Me.txtUrgentie.Value
ws.Cells(iRow, 9).Value = Me.CoBAangenomen.Value
ws.Cells(iRow, 29).Value = Me.txtVestiging.Value
ws.Cells(iRow, 30).Value = Me.txtAdres.Value
ws.Cells(iRow, 31).Value = Me.txtPost.Value
ws.Cells(iRow, 32).Value = Me.txtOmschrijving.Value
'clear the data
Me.txtVolgnummer.Value = ""
Me.txtDatum.Value = ""
Me.txtBedrijf.Value = ""
Me.txtVestiging.Value = ""
Me.txtAdres.Value = ""
Me.txtPost.Value = ""
Me.txtMelder.Value = ""
Me.txtContact.Value = ""
Me.txtTelefoon.Value = ""
Me.txtOnderwerp.Value = ""
Me.txtOmschrijving.Value = ""
Me.txtUrgentie.Value = ""
Me.CoBAangenomen.Value = ""
Me.txtDatum.SetFocus
Unload Me
Dim objOutlk As Object
Dim objMail As Object
Dim strMsg As String
Set objOutlk = CreateObject("Outlook.Application")
Set objMail = objOutlk.createitem(olMailItem)
Set MyAttachements = objMail.Attachments
With objMail 'To will support more than one email address as shown below
.To = "adres@provider.nl"
.cc = "adres@provider.nl"
.Subject = "Er is een nieuwe testmelding" 'Subject
.body = strMsg 'Body
.Send 'Send mailnt
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Quit
End Sub