Pdf openen en opslaan op vaste locatie met..................

ExcelTonnie

Gebruiker
Lid geworden
5 jul 2016
Berichten
308
Stel ik krijg een Pdf in een willekeurige map aangeleverd door een collega.
Deze wil ik openen en gelijk weer sluiten maar dan met een bestandsnaam die opgebouwd is uit waarden uit cellen.
Ben hier mee bezig maar lukt me niet om de pdf op te slaan, er wordt wel een Pdf opgeslagen in de juiste map en ook met de nieuwste bestandsnaam maar hij maakt van het werkboek een Pdf.
Oefenbestandje bijgevoegd met een test Pdf.
 

Bijlagen

  • Pdf2NewPdf.xlsm
    23,6 KB · Weergaven: 7
  • Testfile.pdf
    151,4 KB · Weergaven: 6
Maak er dit van:
Code:
Sub fileopen()
    FromPDF = Application.GetSaveAsFilename(ThisWorkbook.Path, "PDF Files (*.pdf), *.pdf")
    If FromPDF <> False Then
        ToPDF = ThisWorkbook.Path & "\Pdf files\" & "WI130-" & Range("A3") & " VB " & Range("B3") & ".pdf"
        If MsgBox(ToPDF, vbQuestion + vbOKCancel, "Nieuwe naam voor Pdf") = vbOK Then
            Name FromPDF As ToPDF
        End If
    End If
End Sub
 
Laatst bewerkt:
Tot zover werkt het echter wanneer deze bestandsnaam al bestaat wil ik de mogelijkheid hebben om ervoor te kiezen om deze te overschrijven. De makro stop nu dus bij.
Code:
Name FromPDF As ToPDF


heb er even dit van gemaakt echter is dit dus niet de bedoeling.

Code:
Sub fileopen()
On Error GoTo foutje
    FromPDF = Application.GetSaveAsFilename(ThisWorkbook.Path, "PDF Files (*.pdf), *.pdf")
    If FromPDF <> False Then
        ToPDF = ThisWorkbook.Path & "\Pdf files\" & "WI130-" & Range("A3") & " VB " & Range("B3") & ".pdf"
        If MsgBox(ToPDF, vbQuestion + vbOKCancel, "Nieuwe naam voor Pdf") = vbOK Then
            Name FromPDF As ToPDF
        End If
    End If
foutje:
    MsgBox "helaas die bestaat al"
End Sub
 
Doe het eens zo:
Code:
Sub fileopen()
    FromPDF = Application.GetSaveAsFilename(ThisWorkbook.Path, "PDF Files (*.pdf), *.pdf")
    If FromPDF <> False Then
        ToPDF = ThisWorkbook.Path & "\Pdf files\" & "WI130-" & Range("A3") & " VB " & Range("B3") & ".pdf"
        If MsgBox(ToPDF, vbQuestion + vbOKCancel, "Nieuwe naam voor Pdf") = vbOK Then
            Application.DisplayAlerts = False
            Name FromPDF As ToPDF
            Application.DisplayAlerts = True
        End If
    End If
End Sub
En anders met de Dir() functie controleren of de PDF al bestaat en dan vragen of deze overschreven mag worden.
 
Ok. Zo dan, wat ik als laatste regel zei:
Code:
Sub fileopen()
    FromPDF = Application.GetSaveAsFilename(ThisWorkbook.Path, "PDF Files (*.pdf), *.pdf")
    If FromPDF <> False Then
        ToPDF = ThisWorkbook.Path & "\Pdf files\" & "WI130-" & Range("A3") & " VB " & Range("B3") & ".pdf"
        If MsgBox(ToPDF, vbQuestion + vbOKCancel, "Nieuwe naam voor Pdf") = vbOK Then
            If Dir(ToPDF) <> "" Then
                If MsgBox(ToPDF & " bestaat al. Overschrijven?", vbOKCancel + vbQuestion, "PDF bestaat") = vbOK Then
                    Kill ToPDF
                    Name FromPDF As ToPDF
                End If
            Else
                Name FromPDF As ToPDF
            End If
        End If
    End If
End Sub
 
Even een opheldering.
Als ik het zelfde bestand laad als die opgeslagen staat dan wordt het genegeerd.
Als ik een ander bestand open en de naam is de cellen zijn onveranderd dan komt die met bovenstaande melding.
 
Zie #6.
 
Duurde even want moest een en ander ff testen. Het doet wat het moet doen maar er is mij opgevallen dat de file op de "ophaal" locatie verdwijnt. Op zich niet zo erg maar zou dit niet verwachten maar misschien lees ik het verkeerd omdat er staat KILL ToPDF (voor mij logischer als er stond KILL FromPDF.
 
Kill ToPDF verwijderd de bestaande ToPDF in de nieuwe locatie.
De FromPDF verdwijnt omdat de Name opdracht deze hernoemd naar de nieuwe locatie.
In plaats van Name kan je ook FileCopy gebruiken.
 
Ok heldere uitleg.
Tot zover bedankt voor je hulp.
Ga dit even verwerken in mijn project.
 
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan