Macro to create 2 Folders

KenR60
over 2 years ago

I'm using CorelDraw 2018 and each time I create a Drawing I save the drawing into a Job Folder named after the Filename. Manually I then create 3 Folders within this Job Folder, was wanting to create a Macro so I could Save the Filename to the Job Folder and then press a Function Key to create the other 3 Folders automatically.

An Example would be like shown with the "<Job Folder>" being the folder name the Cdr file is saved in.

C:\<Job Folder Name>/Files

C:\<Job Folder Name>/Files/Focus/

C:\<Job Folder Name>/Files/SinoColor

Hoping someone can help me out with this. Thanks in Advance

Parents
No Data
Reply
  • over 2 years ago

    You could try this VBA code:

    Sub create_folders_01()

Dim FSO As New FileSystemObject
Dim strBaseFilePath As String
Const strSubFolder1Name = ""

    If Not ActiveDocument Is Nothing Then
        strBaseFilePath = ActiveDocument.FilePath
        If Not strBaseFilePath = "" Then
            If Not FSO.FolderExists(strBaseFilePath & "Files") Then
                FSO.CreateFolder (strBaseFilePath & "Files")
            Else
                MsgBox "The folder" & vbcrlf & vbcrlf & """" & strBaseFilePath & """" & vbcrlf & vbcrlf & "already exists."
            End If
            
            If Not FSO.FolderExists(strBaseFilePath & "Files\Focus") Then
                FSO.CreateFolder (strBaseFilePath & "Files\Focus")
            Else
                MsgBox "The folder" & vbcrlf & vbcrlf & """" & strBaseFilePath & "Files\Focus\" & """" & vbcrlf & vbcrlf & "already exists."
            End If
            
            If Not FSO.FolderExists(strBaseFilePath & "Files\SinoColor") Then
                FSO.CreateFolder (strBaseFilePath & "Files\SinoColor")
            Else
                MsgBox "The folder" & vbcrlf & vbcrlf & """" & strBaseFilePath & "Files\SinoColor\" & """" & vbcrlf & vbcrlf & "already exists."
            End If
        Else
            MsgBox "No file path is available for the active document." & vbcrlf & vbcrlf & "Document must be saved in order to have a file path."
        End If
    Else
        MsgBox "No document is active."
    End If
End Sub
Children

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.