HWV
Terugkerende gebruiker
- Lid geworden
- 19 feb 2009
- Berichten
- 1.183
Beste,
Ik werk met een formulier met meerdere macro`s, waarvan ik er ook één gebruik om het formulier te verzenden.
Enkel dan krijg ik eerst de bovenstaande melding.
Ik wil namelijk het formulier verzenden zo dat de ontvanger geen macro's meer heeft in dit bestand.
Mijn vraag is kan ik deze melding onderdrukken zodat er gewoon verder gegaan wordt zonder dat er deze melding gegeven gaat worden.
Mijn code die ik gebruik voor het verzenden kom van Ron de Bruin, die ik iets heb aangepast:
Code:
Sub Mail_ActiveSheet()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
Dim Bestandsnaam
Set Bestandsnaam = Worksheets("Bestellijst1").Range("P1")
Dim MailTo
Set MailTo = Worksheets("Bestellijst1").Range("Q14")
Dim MailCC
Set MailCC = Worksheets("Bestellijst1").Range("Q15")
Dim KlantNaam
Set KlantNaam = Worksheets("Bestellijst1").Range("E7")
Dim Accountmanger
Set Accountmanger = Worksheets("Bestellijst1").Range("E14")
Dim Artikel
Set Artikel = Worksheets("Bestellijst1").Range("L35")
Dim ArtikelNr
Set ArtikelNr = Worksheets("Bestellijst1").Range("D19")
Dim ArtikelOmschrijving
Set ArtikelOmschrijving = Worksheets("Bestellijst1").Range("B21")
Dim GevraagdeLeverdatum
Set GevraagdeLeverdatum = Worksheets("Bestellijst1").Range("F45")
Dim FormulierNaam
Set FormulierNaam = Worksheets("Bestellijst1").Range("I1")
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "" & Bestandsnaam & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "" & MailTo & ""
.CC = "" & MailCC & ""
.BCC = ""
.Subject = "" & Bestandsnaam & ""
If GevraagdeLeverdatum = "" Then
If Artikel = "" Then
If ArtikelNr = "" Then
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze " & FormulierNaam & " van de klant " & KlantNaam & "in behandeling nemen." _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
Else
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze " & FormulierNaam & " van de klant " & KlantNaam & "in behandeling nemen, met het volgende artikel:" _
& vbCrLf & vbCrLf & "" & ArtikelNr & " " & "" & ArtikelOmschrijving & " " _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
End If
Else
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze " & FormulierNaam & " van de klant " & KlantNaam & "in behandeling nemen, met het volgende artikel:" _
& vbCrLf & vbCrLf & "" & Artikel & "" _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
End If
Else
If Artikel = "" Then
If ArtikelNr = "" Then
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze " & FormulierNaam & " van de klant " & KlantNaam & "in behandeling nemen." _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Let op de gevraagde leverdatum van " & GevraagdeLeverdatum & "" _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
Else
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze order van de klant " & KlantNaam & "in behandeling nemen, met het volgende artikel:" _
& vbCrLf & vbCrLf & "" & ArtikelNr & " " & "" & ArtikelOmschrijving & " " _
& vbCrLf & vbCrLf & "Let op de gevraagde leverdatum van " & GevraagdeLeverdatum & "" _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
End If
Else
.Body = "Beste collega's," _
& vbCrLf & "" _
& vbCrLf & "In de bijlage vind je de " & FormulierNaam & " van " & KlantNaam _
& vbCrLf & "Graag deze " & FormulierNaam & " van de klant " & KlantNaam & "in behandeling nemen, met het volgende artikel:" _
& vbCrLf & vbCrLf & "" & Artikel & "" _
& vbCrLf & vbCrLf & "Let op de gevraagde leverdatum van " & GevraagdeLeverdatum & "" _
& vbCrLf & vbCrLf & "Ik ga er vanuit dat deze " & FormulierNaam & " met de grootste zorg in behandeling genomen zal worden." _
& vbCrLf & vbCrLf & "Met vriendelijke groet" & vbCrLf & vbCrLf & Accountmanger
End If
End If
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub