Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hello Community,
I want to create a macro which allows me to export Excel file with a specific name like 'File_10102019.xls'
I've created a variable vFileName and i defined it like : ='File_'&Date(today(),'DDMMYYYY')
and i set a variable giving it the value above and passed it to the macro like the code bellow.
but it doesn't work, and maybe someone could help me 😄
Thank you so much 😄
Sub exportToExcel()
DIM vFileName
Set obj = ActiveDocument.GetSheetObject("CH04")
SET f = ActiveDocument.Variables("vFileName")
fname = f.GetContent.STRING
obj.ExportBiff "fname"
dim ExcelApp, ExcelWB
set ExcelApp = createobject("Excel.Application")
ExcelApp.visible = true
set ExcelWB = ExcelApp.Workbooks.Open("fname")
Set obj = nothing
End Sub
Here's the solution this macro .. give u the opportunities to export file in xlsx format ,display it on the screen and save it in a specific repository .. thanks to the community for help 😄
Sub Export
Dim oXLDoc, i
set oXL = CreateObject("Excel.Application")
oXL.DisplayAlerts = False
oXL.visible = True 'False to hide the excel
Set oXLDoc = oXL.Workbooks.Add
FilePath = "C:\Users\a.e\Desktop\TEST_AUTOMATISATION_FILE\" ' File path can be changed later.
FileName = "Fichier_d'Enrichissisement_tiers_" & ActiveDocument.Evaluate("date(Now(), 'DDMMYYYY')") 'Date format can be changed later
'---------------------------------------
SheetObj=Array("CH04") 'Chart ID's
'---------------------------------------
for i=0 to UBound(SheetObj)
oXL.Sheets.Add
oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(SheetObj(i))
obj.CopyTableToClipboard True
oSH.Paste
'sCaption=obj.GetCaption.Name.v
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oXL.Selection.AutoFilter
oSH.Cells.Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
'oSH.Name=left(Feuil1,30)
Set obj=Nothing
Set oSH=Nothing
Next
'---------------------------------------
Call DeleteBlankSheets(oXLDoc)
'---------------------------------------
oXLDoc.Sheets(1).Select
oXLDoc.SaveAs FilePath & FileName & ".xlsx"
oXL.DisplayAlerts = True
oXLDoc.Close True
oXL.Quit
dim ExcelApp, ExcelWB
set ExcelApp = createobject("Excel.Application")
ExcelApp.visible = true
set ExcelWB = ExcelApp.Workbooks.Open(FilePath & FileName & ".xlsx")
Set oXL =Nothing
Set oXLDoc =Nothing
Msgbox "Exportation terminée avec succès."+ VbCrLf + "Veuillez Supprimer les doublons."
End Sub
Private Sub DeleteBlankSheets(ByRef oXLDoc)
For Each ws In oXLDoc.Worksheets
If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
On Error Resume Next
Call ws.Delete()
End If
Next
End Sub
Try:
evaluate(Date(today(),'DDMMYYYY'))
Ayoub, did Mike's post help you get this working? If so, be sure to come back and use the Accept as Solution button on his post to let others know it worked and to give him credit for the help. If you did something else, consider posting that and mark it, and if you are still working on things, leave an update.
Regards,
Brett
Here's the solution this macro .. give u the opportunities to export file in xlsx format ,display it on the screen and save it in a specific repository .. thanks to the community for help 😄
Sub Export
Dim oXLDoc, i
set oXL = CreateObject("Excel.Application")
oXL.DisplayAlerts = False
oXL.visible = True 'False to hide the excel
Set oXLDoc = oXL.Workbooks.Add
FilePath = "C:\Users\a.e\Desktop\TEST_AUTOMATISATION_FILE\" ' File path can be changed later.
FileName = "Fichier_d'Enrichissisement_tiers_" & ActiveDocument.Evaluate("date(Now(), 'DDMMYYYY')") 'Date format can be changed later
'---------------------------------------
SheetObj=Array("CH04") 'Chart ID's
'---------------------------------------
for i=0 to UBound(SheetObj)
oXL.Sheets.Add
oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(SheetObj(i))
obj.CopyTableToClipboard True
oSH.Paste
'sCaption=obj.GetCaption.Name.v
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oXL.Selection.AutoFilter
oSH.Cells.Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
'oSH.Name=left(Feuil1,30)
Set obj=Nothing
Set oSH=Nothing
Next
'---------------------------------------
Call DeleteBlankSheets(oXLDoc)
'---------------------------------------
oXLDoc.Sheets(1).Select
oXLDoc.SaveAs FilePath & FileName & ".xlsx"
oXL.DisplayAlerts = True
oXLDoc.Close True
oXL.Quit
dim ExcelApp, ExcelWB
set ExcelApp = createobject("Excel.Application")
ExcelApp.visible = true
set ExcelWB = ExcelApp.Workbooks.Open(FilePath & FileName & ".xlsx")
Set oXL =Nothing
Set oXLDoc =Nothing
Msgbox "Exportation terminée avec succès."+ VbCrLf + "Veuillez Supprimer les doublons."
End Sub
Private Sub DeleteBlankSheets(ByRef oXLDoc)
For Each ws In oXLDoc.Worksheets
If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
On Error Resume Next
Call ws.Delete()
End If
Next
End Sub