Create folder and sub folder to save exported file

[arpita]

Hi,

I need to export to Pivot tables and a Line chart to an excel file. I have used the below code. In this case, it asks me where to save the file, but I want it to be saved in a particular folder while creating year and month folder itself.

For eg: It saves in \\FO\MO\TLM\2021\March wherein the year (2021) and month(March) is created dynamically so that it changes with change in year and month

Sub Export
Dim objShell
Dim objFolder
Dim excelFile
Dim curWorkBook

   Set objShell = CreateObject("Shell.Application")
   Set objFolder = objShell.BrowseForFolder(0, "Select the path to save the excel:", 1, "Computer")
   On Error Resume Next
      If objFolder Is Nothing Then
        Set objShell = nothing
        Set objFolder = nothing
        Exit sub
      End If
 'File name
 FileName = "ABC") & ".xlsx"
 
     'Create the Excel spreadsheet 
     Set excelFile = CreateObject("Excel.Application")
     excelFile.Visible = False
     'Create the WorkBook
     Set curWorkBook = excelFile.WorkBooks.Add
     'Create the Sheet
     Set curSheet = curWorkBook.WorkSheets(1)
 
     'Get the chart we want to export
     Set tableToExport = ActiveDocument.GetSheetObject("Break Volume")
     Set chartProperties = tableToExport.GetProperties
     tableToExport.CopyTableToClipboard true
 
      'Get the caption
     chartCaption = tableToExport.GetCaption.Name.v
     'MsgBox chartCaption
 
     'Set the first cell with the caption
     curSheet.Range("A1") = chartCaption
     'Paste the rest of the chart
     curSheet.Paste curSheet.Range("A2")
 
 
     'Get the chart we want to export
     Set tableToExport = ActiveDocument.GetSheetObject("Break Scenerio")
     Set chartProperties = tableToExport.GetProperties
     tableToExport.CopyTableToClipboard true
 
      'Get the caption
     chartCaption = tableToExport.GetCaption.Name.v
     'MsgBox chartCaption
 
     'Set the first cell with the caption
     curSheet.Range("J1") = chartCaption
     'Paste the rest of the chart
     curSheet.Paste curSheet.Range("J2")
    
    
 
     'Save the file and quit excel
     curWorkBook.SaveAs objFolder.self.path & "\" &  FileName
     curWorkBook.Close
     excelFile.Quit
   
    Msgbox "File exported successfully!!"
     'Cleanup
     Set objShell = nothing
     Set objFolder = nothing
     Set curWorkBook = nothing
     Set excelFile = nothing
End Sub 
 

Please help

[Frank_Hartmann]

Maybe like this:

Sub Export
Dim objShell
Dim objFolder
Dim excelFile
Dim curWorkBook

   'Set objShell = CreateObject("Shell.Application")
   'Set objFolder = objShell.BrowseForFolder(0, "Select the path to save the excel:", 1, "Computer")
'   On Error Resume Next
'      If objFolder Is Nothing Then
'        Set objShell = nothing
'        Set objFolder = nothing
'        Exit sub
'      End If
 'File name
 'FileName = "ABC") & ".xlsx"
 
     'Create the Excel spreadsheet 
     Set excelFile = CreateObject("Excel.Application")
     excelFile.Visible = False
     'Create the WorkBook
     Set curWorkBook = excelFile.WorkBooks.Add
     'Create the Sheet
     Set curSheet = curWorkBook.WorkSheets(1)
 
     'Get the chart we want to export
     Set tableToExport = ActiveDocument.GetSheetObject("Break Volume")
     Set chartProperties = tableToExport.GetProperties
     tableToExport.CopyTableToClipboard true
 
      'Get the caption
     chartCaption = tableToExport.GetCaption.Name.v
     'MsgBox chartCaption
 
     'Set the first cell with the caption
     curSheet.Range("A1") = chartCaption
     'Paste the rest of the chart
     curSheet.Paste curSheet.Range("A2")
 
 
     'Get the chart we want to export
     Set tableToExport = ActiveDocument.GetSheetObject("Break Scenerio")
     Set chartProperties = tableToExport.GetProperties
     tableToExport.CopyTableToClipboard true
 
      'Get the caption
     chartCaption = tableToExport.GetCaption.Name.v
     'MsgBox chartCaption
 
     'Set the first cell with the caption
     curSheet.Range("J1") = chartCaption
     'Paste the rest of the chart
     curSheet.Paste curSheet.Range("J2")
    
     set filesys=CreateObject("Scripting.FileSystemObject") 
     newfolderpath = "\\FO\MO\TLM\"&year(now())&"\"&month(now())
     Set newfolder = filesys.CreateFolder(newfolderpath)
 
     'Save the file and quit excel
     curWorkBook.SaveAs newfolderpath
     curWorkBook.Close
     excelFile.Quit
   
    Msgbox "File exported successfully!!"
     'Cleanup
     Set objShell = nothing
     Set objFolder = nothing
     Set curWorkBook = nothing
     Set excelFile = nothing
End Sub 

[arpita]

Hi Frank,

this doesn't work