define the destination folder + Avoid macro error if file already exists

[Flavien]

Hello,

This macro should open, one by one, the workbooks located in a folder and save a copy in pdf format.

To make this more flexible, I write the path to the destination folder in cell K5 of my master file.

Example path:
P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU\GCU A VALIDER\CA VERSO\FAST\ESSAI COPIE" & "\"

My macro seems to work, but the PDFs are not saved in the “ESSAI COPIE” folder which contains the workbooks, but in the K - Qualité Usinage” file.

> Do you have a solution to save the pdf in the source file (“ESSAI COPIE”)?
> Additionally, how can I avoid blocking the macro if the file already exists?

Sub enregistrer_copie_pdf()

Dim oFSO As Object
Dim oDossier As Object
Dim oFichier As Object
Dim I As Integer
Dim wb As Workbook
Dim wb1 As Workbook
Dim ws As Object
Dim chemin As String, pos&
Dim ws1, ws2 As Worksheet

' Application.ScreenUpdating = False

'   MAJ de l'écran
    Application.ScreenUpdating = False


Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oDossier = oFSO.GetFolder(ThisWorkbook.Worksheets("IMPRESSION").Range("K5").Value & "\")

For Each oFichier In oDossier.Files

'   Open each workbook contained in the folder // Ouvrir chaque classeur contenu dans le dossier

Set wb = Workbooks.Open(Filename:=oFichier)

' Get workbook name // Récupérer le nom du classeur
    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")



' Save a copy of the file as pdf // Enregistrer une copie du fichier au format pdf

    Sheets(Array("PCP A3H", "Métrologie Saisie Manuscrite")).Select
    Sheets("PCP A3H").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(chemin, pos - 1) & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False  'True

' Close the workbook and move on to the next one // Fermer le classeur et passer au suivant

wb.Close savechanges = False


Next oFichier

Application.ScreenUpdating = True

End Sub

 

[jolivanes]

Macro to print to PDF saves files to desktop

Would this thread be of any help?

If not, maybe let us know what needs to be added and/or changed

 

[John_w]

To make this more flexible, I write the path to the destination folder in cell K5 of my master file.

Example path:
P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU\GCU A VALIDER\CA VERSO\FAST\ESSAI COPIE" & "\"

My macro seems to work, but the PDFs are not saved in the “ESSAI COPIE” folder which contains the workbooks, but in the K - Qualité Usinage” file.

Because the lines

    chemin = ActiveWorkbook.Name
    pos = InStr(chemin, ".xlsm")

and Filename:=Left(chemin, pos - 1) & ".pdf" extract only the file name of the opened workbook, without its folder path, and therefore the PDFs are saved in the default folder.

You could use ActiveWorkbook.FullName instead, but the loop attempts to open every file in the folder (.pdf, .xlsm, etc.) and therefore you should check that the file name contains ".xlsm" before attempting to open it. Try this revised macro.

Sub enregistrer_copie_pdf()

    Dim oFSO As Object
    Dim oDossier As Object
    Dim oFichier As Object
    Dim I As Integer
    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim ws As Object
    Dim pos As Long
    Dim ws1, ws2 As Worksheet
    
    '   MAJ de l'écran
    Application.ScreenUpdating = False
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    Set oDossier = oFSO.GetFolder(ThisWorkbook.Worksheets("IMPRESSION").Range("K5").Value & "\")
    
    For Each oFichier In oDossier.Files
    
    '   Open each workbook contained in the folder // Ouvrir chaque classeur contenu dans le dossier
    
        pos = InStrRev(oFichier.Path, ".xlsm", -1, vbTextCompare)
        
        If pos > 0 Then
        
            Set wb = Workbooks.Open(Filename:=oFichier.Path)
        
            ' Get workbook name // Récupérer le nom du classeur
            'chemin = ActiveWorkbook.FullName
            'pos = InStr(chemin, ".xlsm")
        
            ' Save a copy of the file as pdf // Enregistrer une copie du fichier au format pdf
        
            wb.Sheets(Array("PCP A3H", "Métrologie Saisie Manuscrite")).Select
            'Sheets("PCP A3H").Activate
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(oFichier.Path, pos - 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=False  'True
        
            ' Close the workbook and move on to the next one // Fermer le classeur et passer au suivant
        
            wb.Close SaveChanges:=False
        
        End If
    
    Next oFichier
    
    Application.ScreenUpdating = True

End Sub

 

[jolivanes]

@ John_w
In the "oDossier" line. The backslash is already in the cell with the path. There is also an extra double quotation mark in that cell by the looks of it.

 

[John_w]

I don't think that's the case because the OP says the macro seems to work .... except. If K5 contained an invalid path the code would error at the Set oDossier line. In fact, that line should be:

    Set oDossier = oFSO.GetFolder(ThisWorkbook.Worksheets("IMPRESSION").Range("K5").Value)

and then it doesn't matter if the K5 path has a trailing "\" or not.

I'd expect K5 to contain:

P:\01-Qualité\K - Qualité Usinage\05 - CREATION PCP PREMIER NIVEAU\GCU A VALIDER\CA VERSO\FAST\ESSAI COPIE

 

[jolivanes]

Yes, what you expect K5 to have is what I thought. Could be that the culprit is in the Copy & Paste.