Macro Export Excel with current Date

[Ayoub]

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

[m_woolf]

Try:

evaluate(Date(today(),'DDMMYYYY'))

[Brett_Bleess]

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

[Ayoub · Accepted solution]

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