VBA-Pdf maken en versturen werkt opeens niet meer

boppe · 7 aug 2020

Hallo

Onderstaande macro gebruik ik in het formulier bij het indrukken van een knop. Dat wordt er een PDF van gemaakt en per mail verstuurd.
Opeens werkt het niet meer bij de collega's.
Nu vermoed ik dat office365 hier debet aan is omdat deze collega's een andere computer hebben gekregen met dus excel365 erop.

Ze hebben wel een C:\Formulieren map op hun lokale PC.

Hoe kan ik het weer werkend krijgen in offe365?

Code:

Option Explicit

'Met deze module wordt het document opgeslagen als PDF in de map: C:\Formulieren
'Er vindt eerst een controle plaats voor de verplichte velden
'postcode/huisnummer, serienummer en conclusie
'De pdf wordt getoond maar kan eventueel uitgeschakeld worden
'Vervolgens wordt deze PDF als bijlage automatisch verstuurd naar mailadres: EMAIL@ADRES.nl
'

Sub Maak_een_PDF_en_mail_dit_bestand_automatisch()
'Working only in 2007 and up
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
        Dim FileName As String
    Dim Sysdate
    Sysdate = Format(Date, "YYYY/mm/dd")

    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "waar staan de bestanden"
    TempFilePath = "C:\Formulieren\"
    
    

    'Loop through every worksheet
    For Each sh In ThisWorkbook.Worksheets
        FileName = ""

        'Test A50 for a mail address
        If sh.Range("A50").Value Like "?*@?*.?*" Then
        
        'fieldcontroll
        
         If Not Dir(TempFilePath & FileName & ".pdf") = Empty Then
       If MsgBox("Het bestand " & FileName & " bestaat al in " & vbCrLf & TempFilePath & vbCrLf & "Wil je dit bestand overschrijven?", vbExclamation + vbOKCancel, "LET  OP !!  Bestand bestaat al!") = vbCancel Then Exit Sub
   End If
   
   If Range("E4") = Empty Then
       If MsgBox("Er is geen postcode + nr ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
   End If
   
      
   If Range("N3") = Empty Then
    If MsgBox("Er is geen serienummer ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
   End If
   
      If Range("C47") = Empty Then
       If MsgBox("Er is nog geen resultaat ingevuld. Maak een keuze tussen 'a', 'b', 'c' of 'd' en kies dan opnieuw Opslaan als PDF.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
   
    End If
        
 

            'If there is a mail address in A50 create the file name and the PDF
            TempFileName = TempFilePath & "WB__" & Format(Now, "yyyy-mm-dd_") & (Range("E4").Value) & "_snr_" & (Range("N3").Value) & ".pdf"
            
            FileName = RDB_Create_PDF(Source:=sh, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=False, _
                                      OpenPDFAfterPublish:=True)

                                
         
            
            
            
            'If publishing is OK create the mail
                        
            If FileName <> "" Then
          
            
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="EMAIL@ADRES.nl", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Meetresultaten WB", _
                                     Signature:=True, _
                                     Send:=True, _
                                     StrBody:="<body>Beste collega, <br><br><br>" & _
                                              "Hierbij ontvangt u de meetresultaten van de WB die ik recentelijk heb onderzocht." & _
                                              "<br><br>" & "NB  Deze mail is automatisch gegenereerd en verstuurd.</body>"
            Else
                MsgBox "Het lukt dit programma niet om een PDF te maken. Dat kan de volgende oorzaken hebben:" & vbNewLine & _
                       " " & vbNewLine & _
                       "* Er staat een foutief teken in de postcode of het serienummer veld" & vbNewLine & _
                       "   (alleen een - is toegestaan)! " & vbNewLine & _
                       " " & vbNewLine & _
                       "* Het bestand heeft u al opgeslagen. Indien de meting nog een keer" & vbNewLine & _
                       "  moet plaatsvinden, zet dan een B achter het serienummer. " & vbNewLine & _
                       " " & vbNewLine & _
                       "* Het formulier heb je opnieuw gedownload en foutief opgeslagen. " & vbNewLine & _
                       "  Sla dit formulier op in:   C:\Formulieren."
                       
                       
            End If
  

        End If
    Next sh
End Sub

Groet Robert

VenA · 7 aug 2020

Wat werkt er dan niet? Krijgen ze een foutmelding? Zo ja, wat is de foutmelding? Op welke regel krijgen ze de foutmelding?

boppe · 7 aug 2020

Het lijkt erop dat het geen PDF maken. Het bericht verschijnt:
MsgBox "Het lukt dit programma niet om een PDF te maken...

We hebben drie formulieren, allen werken al enige jaren met dezelfde soort code. Maar ze nu voorzien zijn van het office365 pakket, blijft ergens wat hangen.

Men vult de verplichte velden in en is er geen dubbele bestandsnaam in de betreffende map.

JEC. · 7 aug 2020

Ik gok dat het hier of/en hier misgaat

Code:

FileName = RDB_Create_PDF(Source:=sh, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=False, _
                                      OpenPDFAfterPublish:=True)

Code:

RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="EMAIL@ADRES.nl", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Meetresultaten WB", _
                                     Signature:=True, _
                                     Send:=True, _
                                     StrBody:="<body>Beste collega, <br><br><br>" & _
                                              "Hierbij ontvangt u de meetresultaten van de WB die ik recentelijk heb onderzocht." & _
                                              "<br><br>" & "NB  Deze mail is automatisch gegenereerd en verstuurd.</body>"

HSV · 7 aug 2020

Waar zijn de bijhorende UDF's ?

VenA · 7 aug 2020

Dit lijkt mij overzichtelijker.

Code:

Sub VenA()
  c00 = "E:\Temp\"
    For Each sh In ThisWorkbook.Worksheets
      FileName = c00 & "WB__" & Format(Now, "yyyy-mm-dd_") & sh.Range("E4").Value & "_snr_" & sh.Range("N3").Value & ".pdf"
      If sh.Range("A50").Value Like "?*@?*.?*" Then
        If Not Dir(FileName) = Empty Then
          If MsgBox("Het bestand " & FileName & " bestaat al in " & vbCrLf & TempFilePath & vbCrLf & "Wil je dit bestand overschrijven?", vbExclamation + vbOKCancel, "LET  OP !!  Bestand bestaat al!") = vbCancel Then Exit Sub
        End If
      End If
      If sh.Range("E4") = Empty Then
        If MsgBox("Er is geen postcode + nr ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
      If sh.Range("N3") = Empty Then
        If MsgBox("Er is geen serienummer ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
      If sh.Range("C47") = Empty Then
        If MsgBox("Er is nog geen resultaat ingevuld. Maak een keuze tussen 'a', 'b', 'c' of 'd' en kies dan opnieuw Opslaan als PDF.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
   
      sh.ExportAsFixedFormat 0, FileName
      With CreateObject("Outlook.Application").CreateItem(0)
        .to = sh.Range("A50")
        .Subject = "Meetresultaten WB"
        .HTMLBody = "<body>Beste collega, <br><br><br>" & "Hierbij ontvangt u de meetresultaten van de WB die ik recentelijk heb onderzocht." & "<br><br>" & "NB  Deze mail is automatisch gegenereerd en verstuurd.</body>"
        .Attachments.Add FileName
        .display '.send
      End With
    Next sh
End Sub

boppe · 11 aug 2020

Dit lijkt al een stuk beter te werken.

Echter bij het versturen van de email ging het geheel automatisch. Dus niet handmatig op send drukken.
Wanneer ik in bovenstaande code .send activeer, komt onderstaande melding:

Valt dat nog weg te kleien?

VenA · 11 aug 2020

Lijkt mij een beveiligingsinstelling in outlook.

boppe · 1 sep 2020

VenA zei:

Dit lijkt mij overzichtelijker.

Code:

Sub VenA()
  c00 = "E:\Temp\"
    For Each sh In ThisWorkbook.Worksheets
      FileName = c00 & "WB__" & Format(Now, "yyyy-mm-dd_") & sh.Range("E4").Value & "_snr_" & sh.Range("N3").Value & ".pdf"
      If sh.Range("A50").Value Like "?*@?*.?*" Then
        If Not Dir(FileName) = Empty Then
          If MsgBox("Het bestand " & FileName & " bestaat al in " & vbCrLf & TempFilePath & vbCrLf & "Wil je dit bestand overschrijven?", vbExclamation + vbOKCancel, "LET  OP !!  Bestand bestaat al!") = vbCancel Then Exit Sub
        End If
      End If
      If sh.Range("E4") = Empty Then
        If MsgBox("Er is geen postcode + nr ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
      If sh.Range("N3") = Empty Then
        If MsgBox("Er is geen serienummer ingevuld. Hierdoor kan dit bestand niet worden opgeslagen.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
      If sh.Range("C47") = Empty Then
        If MsgBox("Er is nog geen resultaat ingevuld. Maak een keuze tussen 'a', 'b', 'c' of 'd' en kies dan opnieuw Opslaan als PDF.", vbExclamation + vbCritical, "LET  OP !!  Bestand kan niet worden opgeslagen!") = vbOK Then Exit Sub
      End If
   
      sh.ExportAsFixedFormat 0, FileName
      With CreateObject("Outlook.Application").CreateItem(0)
        .to = sh.Range("A50")
        .Subject = "Meetresultaten WB"
        .HTMLBody = "<body>Beste collega, <br><br><br>" & "Hierbij ontvangt u de meetresultaten van de WB die ik recentelijk heb onderzocht." & "<br><br>" & "NB  Deze mail is automatisch gegenereerd en verstuurd.</body>"
        .Attachments.Add FileName
        .display '.send
      End With
    Next sh
End Sub

Na het publiceren van de PDF, het opstarten en afsluiten van het emailprogramma, verschijnt de eerste messagebox weer in beeld. Aan alle eisen zijn voldaan, maar geeft toch de melding weer.
Moet er (en waar) nog een END IF of iets dergelijks bij?

VenA · 1 sep 2020

Het onnodig quoten kan je net zo goed achterwege laten. Gebruik de ingebakken debug mogelijkheden om te kijken waar het fout gaat.

boppe · 7 sep 2020

next sh

Het werkblad wordt met for / next steeds herhaald.

De bedoeling is dat wanneer er een PDF en email zijn opgemaakt, dit formulier klaar is met zijn werk. De gebruiker kan de vakken wissen (en opnieuw invoeren) of excel afsluiten.

Ik piel wat met integer, maar dat is het volgens mij ook niet.

VenA · 7 sep 2020

Welk werkblad? Met de code wordt elk werkblad doorlopen. Wat je met integer bedoelt ontgaat mij. Plaats het bestand maar.

boppe · 7 sep 2020

in bijlage

VenA · 7 sep 2020

Ja en wat wil je nu versturen? Alleen Blad1? Dan moet je de lus weglaten en verwijzen naar het juiste blad.

VBA-Pdf maken en versturen werkt opeens niet meer

boppe

Gebruiker

VenA

Inventaris

boppe

Gebruiker

JEC.

Terugkerende gebruiker

HSV

Inventaris

VenA

Inventaris

boppe

Gebruiker

VenA

Inventaris

boppe

Gebruiker

VenA

Inventaris

boppe

Gebruiker

VenA

Inventaris

boppe

Gebruiker

Bijlagen

VenA

Inventaris

Nieuwste berichten

Wij waarderen jouw privacy