File Save As VBA UNC with Multi-Level folder creation level for automation (1 Viewer)

Rx_

Nothing In Moderation
Local time
Today, 06:43
Joined
Oct 22, 2009
Messages
2,803
Found several code samples to start. If anyone has suggestions for creating a multi-tier directory structure for a SaveAs - please chip in.
Sorry, had a last minute design change - nobody responded so will update the requirement and code. Will add more code as day progresses.
Output: General UNC Path + folderName with YEAR plus another folder name + ReportName Folder + Month Subfolder

Report Name is passed in as parameter - Month (03 - Mar) is dynamic
If a new folder is created, verify the folder is complete

Code:
 Public Const UNCReportPath As String = "[URL="file://\\Folder05\finance\"]\\Folder05\finance\[/URL]"   ' leave room to add Year
 Public Const UNCReportPathFolder As String = " FPA\Capital Reporting"  ' Add 4 digit Year and Space then append this
 ' Note: Each Report will be followed by a \Report Name\ then have a folder or file added here
 
 Public Function UNCPathSaveAsReport(Optional ReportFolderName As String = "Risk Assessment") As String ' First report is Risk Assessment
 Dim SubFolderMonthName As String
 Dim CurrentYear As String   ' NOTE for testing Add 1 year then remove for delivery
 Dim FullUNCPath As String
 Dim FullUncPathToCreate As String
 On Error GoTo err_Trap
 ' Use the current Date to evaluate if a new folder (e.g. 03-Mar)  needs to be created - if folder exist, then continue
 ' Create today's Month string
 SubFolderMonthName = CStr(Format(Month(Date), "00") & " - " & MonthName(Month(Date), True) & "")
 CurrentYear = CStr(Format(Year(Date), "0000") + 1)  ' <------------ CHANGE +1  to +0 used for Testing when Delivered into Production
 FullUNCPath = UNCReportPath & CurrentYear & UNCReportPathFolder & SubFolderMonthName       ' Test to see if exist or to create
 FullUncPathToCreate = UNCReportPath & CurrentYear & UNCReportPathFolder                    ' If Path above doesn't exist - can use this to add subFolderMonthName
Debug.Print FullUNCPath
 Debug.Print FullUncPathToCreate
 If Dir(FullUNCPath, vbDirectory) = "" Then
    Debug.Print "directory doesnt exist"
        If Dir(FullUncPathToCreate, vbDirectory) = "" Then
            Debug.Print "Something is very wrong - root path is not there"
        Else
            Debug.Print "Path exist but needs to have Sub Directory added"
            MkDir FullUNCPath
            If Dir(FullUNCPath, vbDirectory) = "" Then
                Debug.Print "Something is wrong, the root path exist but the subdirecory couldn't be created"
                ' e.g. raise an error - perhaps the user doesn't have rights to create
            Else
                Debug.Print "Now the full directory exist and is ready to use"
            End If
        End If
 Else
    Debug.Print "Directory Alerady exist Please continue"
 End If
  FullUNCPath = FullUNCPath & ""  ' add "" to be ready for a SaveAs
 UNCPathSaveAsReport = FullUNCPath
 Exit Function
err_Trap:
    Debug.Print "Add error trap code for UNCPathSaveAsReport"
End Function
 
Last edited:

jdraw

Super Moderator
Staff member
Local time
Today, 08:43
Joined
Jan 23, 2006
Messages
15,361
If I recall correctly, MkDir only allows 1 level of a directory to be created.
If you have a directory A, and you want to end up with A\b\c you have to create A\b, and then A\b\c. That is, one level at a time - loop of some sort.

Good luck.
 
Last edited:

Rx_

Nothing In Moderation
Local time
Today, 06:43
Joined
Oct 22, 2009
Messages
2,803
So correct - after a scope change - this is working code.
Will be adding more constants and other improvements.
However, this should provide an idea of how to check down the directory path and create a new subfolder as dates change.

Code:
' Public Function to SaveAs into network directories and create month folders 
' ******* Example:  [URL="file://\\Network05\Fin$\2017"]\\Network05\Fin$\2017[/URL] FPA\2017 Monthly Capital Forecast\03 March\NCO\Reports\Risk Assessment
' Where [URL="file://\\Network05\Fin$\2017"]\\Network05\Fin$\2017[/URL] FPA\2017 Monthly Capital Forecast    Name of Network folder where reports are saved to for each month
' Where \03 March    is a Subfolder that will be created based on today's date
' Where \NCO    represents an 3 letter Organization retrieved from DB using a For Each Org - created if not present
' Where \Reports is a default folder name for Each Org to place the Reports
' where \Risk Assessment is an optional Report Name (as string) passed into the function to create a subfolder for each report 
' A Report is defined:  Afer MSAccess executes a Stored Procedure to SQL Server - the Linked table is used with Excel Object Model Code
'                       to create an Excel workbook that is SavedAs to this path. The Excel Workbook Name includes the MO-DAy in its name.
' *******************************************************************************************************************************
 Public Const UNCReportPath As String = "[URL="file://\\Network05\Fin$\2017"]\\Network05\Fin$\2017[/URL] FPA\2017 Monthly Capital Forecast"   ' Code creates Month
 Public Const UNCReportPathFolder As String = "[URL="file://\\Reports\Risk"]\\Reports\Risk[/URL] Assessment"  ' Name of this Report
 ' Note: Each Report will be followed by a \Report Name\ then have a folder or file added here
 Public Function UNCPathSaveAsReport(Optional ReportFolderName As String = "Risk Assessment", Optional Org As String = "None") As String  ' Org out of For Each, First report is Risk Assessment
 ' If ORG = "XXX" then
 Dim SubFolderMonthName As String
 Dim CurrentYear As String   ' NOTE for testing Add 1 year then remove for delivery
 Dim FullUNCPath As String
 Dim FullUncPathToCreate As String
 Dim FullUncPathOrg     As String
 Dim FullUncPathRpt     As String
 On Error GoTo err_Trap
 ' Use the current Date to evaluate if a new folder (e.g. 03-Mar)  needs to be created - if folder exist, then continue
 ' Create today's Month string
 SubFolderMonthName = CStr(Format(Month(Date), "00") & " " & MonthName(Month(Date), False))
 'CurrentYear = CStr(Format(Year(Date), "0000")) 
 FullUNCPath = UNCReportPath & SubFolderMonthName         ' Test to see if exist or to create   UNCReportPathFolder &
 'FullUncPathToCreate = UNCReportPath & UNCReportPathFolder & "" & ReportFolderName                          ' If Path above doesn't exist - can use this to add subFolderMonthName
 Debug.Print FullUNCPath
 'Debug.Print FullUncPathToCreate
 If Dir(FullUNCPath, vbDirectory) = "" Then
    Debug.Print "directory doesn't exist - Making Directory"
    MkDir FullUNCPath
    DoEvents
 Else
    Debug.Print "Directory Month Already exists"
 End If
 If Org = "None" Then
    ' ************** Note - Summary reports don't reside in an ORG they are up above the Org level
    UNCPathSaveAsReport = FullUNCPath
    Exit Function
 End If
 
 'FullUNCPath = FullUNCPath & ""  ' add "" to be ready for a SaveAs
 ' ****************** Check Next Level of Sub Directory for Org Name ***FullUncPathOrg  FullUncPathRpt
 ' ***************************** \<Org>\Reports\Risk Assessment
  FullUncPathOrg = FullUNCPath & "" & Org
  If Dir(FullUncPathOrg, vbDirectory) = "" Then
    Debug.Print "directory doesn't exist - Making Directory"
    MkDir FullUncPathOrg
    DoEvents
    FullUncPathOrg = FullUncPathOrg & "\Reports"
    MkDir FullUncPathOrg
    DoEvents
 Else
     FullUncPathOrg = FullUncPathOrg & "\Reports"
    Debug.Print "Directory Already exists org\reports"
 End If
 ' Next level Check
   FullUncPathRpt = FullUncPathOrg & "" & ReportFolderName
  If Dir(FullUncPathRpt, vbDirectory) = "" Then
    Debug.Print "directory doesn't exist - Making Directory"
    MkDir FullUncPathRpt
    DoEvents
 Else
    Debug.Print "Directory Already exists org\reports\reportfolder"
 End If
 UNCPathSaveAsReport = FullUncPathRpt
 Exit Function
err_Trap:
    Debug.Print "Add error trap code for UNCPathSaveAsReport"
    MsgBox FullUncPathToCreate & " Network Folder for SaveAs is not Responding " & Err.Description, vbCritical, "Function UNCPathSaveAsReport failed"
    Err.Raise Err.Number
End Function
 

Users who are viewing this thread

Top Bottom