Batch resave CorelDRAW files to a lower version

1. October 2014 mika Comments (0)

A simple VBA script for batch dumping CorelDRAW files to a lower version. 

Sub Resave()

    'remember to add a trailing '\', for example c:\my\path\
    Dim fld As String
    fld = "c:\my\path\"
    
    'make the out fld different than the main fld if needed
    'files are saved with a new name, so original ones will not be overwritten
    'remember to add a trailing '\', for example c:\my\path\
    Dim outFld As String
    outFld = "c:\my\path\out\"
    
    If Len(dir(outFld, vbDirectory)) = 0 Then
       MkDir outFld
    End If
    
    Dim file As String
    
    Dim sopts As StructSaveAsOptions
    Set sopts = CreateStructSaveAsOptions
    With sopts
        'looks like vba is happy to save down to v1...
        'x7 is not happy to reopen them though and the lowest version it is happy with is v12
        'in the gui the lowest save as version is 11 though
        .Version = cdrVersion12
        .Overwrite = True
        .EmbedVBAProject = True
        .Filter = cdrCDR
        .IncludeCMXData = False
        .Range = cdrAllPages
        .EmbedICCProfile = True
        .KeepAppearance = True
    End With
    
    file = dir(fld & "*.cdr")
    
    Do While file <> ""
        Dim doc As Document
        Set doc = OpenDocument(fld & file)
        doc.SaveAs outFld & Replace(file, ".cdr", "_v" & sopts.Version & ".cdr"), sopts
        doc.Close
        file = dir()
    Loop
    
End Sub