• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Formulier mailen als pdf bij opslaan

  • Onderwerp starter Onderwerp starter DieBe
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

DieBe

Gebruiker
Lid geworden
9 mei 2011
Berichten
69
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
 
Maak je code even op met codetags.
Welke Office versie heb je?
 
Je had beter aan het eerste verzoek kunnen voldoen. De controle op het telefoonnummer lijkt mij nogal onzinnig met deze code. Daarna heeft mijn muiswiel het begeven en kon ik dus niet verder kijken.
 
In bijlage een vbtje
Indien je het vertaald wilt zien naar uw situatie post dan een voorbeeldbestandje met wat Jan,Piet,Joris en Corneel gegevens in.
Code plaats je tussen codetags aan de hand van deze knop #
 

Bijlagen

Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan