Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
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
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
Hi Frank,
this doesn't work