Creating a Folder and Saving a Pdf to it based on cell value

[BBLADES]

What I need is a code that will create a folder based on cell "J6" and then save the active sheet as a pdf to that folder with the name from cell "J6". The end result will be 1 click and it saves the pdf and clears the sheet for the next user. I can get them to work seperatly but not together. This is what I have. I am sure there is an easier way.


My file path is S:\Quality Control\Macro testing\ECR Workflow\ECN
-------------------------------------------------------------------------------

To Save the PDF to a folder with the name pulling from the Sheet name and cell J6 I use this code.
---------------------------------------------------------------------------------------------------------------

Sub SvMe()
Dim svPath As String
Dim newFile As String, fName As String

svPath = "S:\Quality Control\Macro testing\ECR Workflow\ECN\ECN-" & Range("J6").Text

fName = Sheets("ECN").Range("J6").Text

'Save it
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=svPath

End Sub

Function MakeFolders(MyStr As String)
'Author: Jerry Beaucaire
'Date: 7/14/2010
'Summary: Create directories and subdirectories based
' on the text strings fed to the function
' This version is to be called by other macros
Dim MyArr As Variant
Dim pNum As Long
Dim pBuf As String

On Error Resume Next

MyArr = Split(MyStr, "\")
pBuf = MyArr(LBound(MyArr)) & "\"
For pNum = LBound(MyArr) + 1 To UBound(MyArr)
pBuf = pBuf & MyArr(pNum) & "\"
MkDir pBuf
Next pNum

End Function


To Create a folder Based on that same cell I use this code
------------------------------------------------------------------

Sub SaveFolder()

Dim FldrName As String

On Error Resume Next

For i = 1 To 10
FldrName = Sheets("ECN").Range("J6").Text

MkDir "S:\Quality Control\Macro testing\ECR Workflow\ECN\ECN-" & FldrName
Next i

End Sub

[Greg M]

Hi there,


See if the following code does what you need. It contains two options:

(a) The "SaveActiveWorksheetInCommonFolder" routine will save the active worksheet using a common filename prefix plus the suffix contained in Cell J6 of the "ECN" worksheet. All files will be saved in the same folder "S:\Quality Control\Macro testing\ECR Workflow\ECN"


(b) The "SaveActiveWorksheetInIndividualFolder" routine will save the active worksheet as described above, but the file will be saved in folder "S:\Quality Control\Macro testing\ECR Workflow\ECN\ECN-" plus the suffix from Cell J6

The code used is as follows:

Option Explicit


'=========================================================================================
'=========================================================================================


Sub SaveActiveWorksheetInCommonFolder()

    Const sFILENAME_PREFIX  As String = "ECN-"
    Const sFOLDER_PATH      As String = "S:\Quality Control\Macro testing\ECR Workflow\ECN"
    Const sSUFFIX_CELL      As String = "J6"
    Const sSHEET_NAME       As String = "ECN"

    Dim sFileNameSuffix     As String
    Dim sFullName           As String

'   Check whether or not the required folder already exists
    If mbFolderExists(sFolderPath:=sFOLDER_PATH) = True Then

'       Determine the suffix to be appended to the file name
        sFileNameSuffix = ThisWorkbook.Worksheets(sSHEET_NAME).Range(sSUFFIX_CELL).Value

'       Determine the full name of the new file
        sFullName = sFOLDER_PATH & "\" & sFILENAME_PREFIX & sFileNameSuffix

'       Save the active worksheet in .pdf format under the above file name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFullName

    End If

End Sub


'=========================================================================================
'=========================================================================================


Sub SaveActiveWorksheetInIndividualFolder()

    Const sFOLDER_PREFIX    As String = "S:\Quality Control\Macro testing\ECR Workflow\ECN\ECN-"
    Const sFILENAME_PREFIX  As String = "ECN-"
    Const sSUFFIX_CELL      As String = "J6"
    Const sSHEET_NAME       As String = "ECN"

    Dim sFolderPath         As String
    Dim sFullName           As String
    Dim sSuffix             As String

'   Determine the suffix to be appended to the folder name and file name
    sSuffix = ThisWorkbook.Worksheets(sSHEET_NAME).Range(sSUFFIX_CELL).Value

'   Determine the name of the new folder
    sFolderPath = sFOLDER_PREFIX & sSuffix

'   Create the new folder if required
    If mbFolderExists(sFolderPath:=sFolderPath) = True Then

'       Determine the full name of the new file
        sFullName = sFolderPath & "\" & sFILENAME_PREFIX & sSuffix

'       Save the active worksheet in .pdf format under the above file name
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFullName

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Function mbFolderExists(sFolderPath As String) As Boolean

    Const sSLASH    As String = "\"

    Dim sFolderName As String
    Dim vaFolders   As Variant
    Dim iFolderNo   As Integer

    On Error GoTo ErrorEncountered

'   Check whether or not the folder already exists
    If Dir$(sFolderPath, vbDirectory) = vbNullString Then

'       Create an array containing the names of the various folders
        vaFolders = Split(sFolderPath, sSLASH)

'       Scan through the names of each of the folders in the above list
        For iFolderNo = LBound(vaFolders) To UBound(vaFolders)

            sFolderName = sFolderName & vaFolders(iFolderNo) & sSLASH

'           Create the required folder if it does not already exist
            If Dir$(sFolderName, vbDirectory) = vbNullString Then
                MkDir sFolderName
            End If

        Next iFolderNo

    End If

    mbFolderExists = True

ExitPoint:

    Exit Function

ErrorEncountered:

    MsgBox "The folder """ & sFolderPath & """ could not be created", vbCritical
    mbFolderExists = False
    Resume ExitPoint

End Function

The highlighted values may be altered to suit your own requirements.

The code contains error handling to cater for the situation where (for whatever reason) one of the required folders cannot be created.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[BBLADES]

That is fantastic! Thank you so much! Helps a ton!

[Alf]

Perhaps a shorter code will do the jobb as well?

Sub tester()

Dim svPath As String
Dim sStr As String
Dim fName As String

sStr = Range("J6").Value


svPath = "S:\Quality Control\Macro testing\ECR Workflow\ECN\ECN-"

If Dir(svPath & "\" & sStr, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & svPath & "\"  & sStr & """")
End If

fName = svPath & "\" & sStr & "\" & Range("J6").Value

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName


End Sub

Alf

[BBLADES]

I'll have to try that one as well. Thanks!

[Greg M]

Hi again,

Many thanks for your very prompt feedback and also for the Reputation increase - much appreciated

You're welcome - I'm glad I was able to help.

Best regards,

Greg M