Help to Modify this vba code.

[Esmatullaharifi]

Hi to every one,


I am using this code to export my query data to excel program but now i changed the destination excel file to macro enabled file to in this case i also changed the extensions in my code from xlsx to xlsm but the code does not now the xlsm extension. How i can successfully change this code to work with macro enable workbook of excel.

Option Compare Database

Option Explicit

Const fPath = "C:\Users\Esmatullah Arifi\Documents\"
Const fName2 = "Exported Data.xlsx" ' Data file to overwrite
Function OpenExcel()

On Error GoTo ErrorHandler

   Dim appExcel As Excel.Application
   Dim bks As Excel.Workbooks
   Dim sht As Excel.Worksheet
   Dim strSheet As String
   Dim MyFile As String
   
   MyFile = fPath & fName2 'Point to the Data file

   DoCmd.OutputTo acQuery, "asa", "Excel Workbook(*.xlsx)", _
MyFile, True, ""

   appExcel.Workbooks.Open (MyFile)
   Set sht = appExcel.ActiveWorkbook.asa
   sht.Activate
   appExcel.Application.Visible = True
   With appExcel
    .Run "Edit"
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err = 429 Then
'Excel is not running; open Excel with CreateObject
      Set appExcel = CreateObject("Excel.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Function

[ranman256]

you cant. the only format is .xlsx
then open it in xl and save as .xlsm

[trevor40]

I do this after formatting my sheets, it saves the file as xlsm then deletes the old file. it can all be done from access. (90% of code removed for clarity.)


this creates the files...

Private Sub Command147_Click()          'create manual time sheet
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim rstActual As DAO.Recordset
    Set rstActual = db.OpenRecordset("manual_sheet")
    gg = "C:\aaa\timesheets\Employee timesheet master.xls"
    bb = InputBox("Enter number of sheets required", "Excel time sheet generation", 1)
    fn = "FirstName"
    Ln = "LastName"
    DoCmd.RunSQL "DELETE * FROM manual_sheet"
    t = Forms![main menu].start_date
    tt = Forms![main menu].End_date
    aa = tt - t
        For i = 1 To aa
        Set rstActual = db.OpenRecordset("manual_sheet", dbOpenDynaset)
        rstActual.AddNew
        rstActual!new_date = t
        rstActual.Update
        rstActual.Close
        t = t + 1
    Next i
    For i = 1 To bb
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Employee Time Report Output with lunch for manual sheet", gg, True, "FirstName" & i & " " & "LastName" & i
    Next i
    Call format_sheets_now
    t = MsgBox("All requested Excel Time Sheets have been created" & vbCrLf & "          And saved in the following directory" & vbCrLf & vbCrLf & "                   C:\aaa\timesheets", vbOKOnly, "Automated Time Sheet Generation")
End Sub

then i clean it up here...

        Excel_Workbook.SaveAs filename:="C:\aaa\timesheets\Employee Timesheet for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        t = Len(Dir("C:\aaa\timesheet backups"))
        If t = 0 Then
        Else
                Excel_Workbook.SaveAs filename:="C:\timesheet backups\Employee Timesheet for - " & sdt & " to " & edt & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        End If
        Excel_Application.DisplayAlerts = True
        Excel_Application.Visible = True

        Kill "C:\aaa\timesheets\Employee Timesheet Master.xls"