• 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.

Melding bij op slaan VB Project (zonder macro op slaan cq verzenden)

Status
Niet open voor verdere reacties.

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
VB MELDING.png

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
 
Wijzig dit stukje:
Code:
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

in:
Code:
    With Destwb
        Application.DisplayAlerts = False
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        Application.DisplayAlerts = True
 
geweldig

Beste Edmoor,

Ik heb het gewijzigd en krijg de melding niet meer.
Dank voor je bijdrage.

HWV
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan