Task Scheduler will not run macro

问题

I am using access 2013 and have setup a macro to be called via the task scheduler. I am currently getting the the error 2001 when opened via the task scheduler. My database has been set as a trusted location but the macro will not complete. I am running under my login. All other macros work perfectly. If I manually open access to run the macro It runs just fine without any errors. I am updating two spreadsheets in this one macro so not sure if this has anything to do with it. Here is the function my macro calls below:

Function SendDailyInvoiceReport()
Dim myOutlook As outlook.Application
Dim filename As String

filename = "M:\Shared Documents\Invoices\Invoicing Reports\DAILY\Daily_Clients_Invoiced_" & Format(DateAdd("d", -1, Now()), "mm_dd_yyyy") & ".xlsx"
filename2 = "M:\Shared Documents\Invoices\Invoicing Reports\Daily\MonthToDate\Clients_Invoiced_Month_To_Date_" & Month(Now()) & "_" & Year(Now()) & ".xlsx"

DoCmd.OpenQuery "all invoices"


DoCmd.OutputTo acOutputQuery, "qryDAILYINVOICEREPORT", acFormatXLSX, filename, False


Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim ws As Worksheet

Set xlApp = New Excel.Application
With xlApp
    .Visible = False
    Set xlWB = .Workbooks.Open(filename, , False)
    Set ws = .Worksheets("qryDAILYINVOICEREPORT")

End With

Dim LR As Long
Dim TotalBilled As Long
Dim TotalClients As Long

LR = ws.Range("C" & ws.Rows.count).End(xlUp).Row
ws.Range("C" & LR + 1).Value = "TOTAL # OF INVOICES:"
ws.Range("C" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("D" & ws.Rows.count).End(xlUp).Row
ws.Range("D" & LR + 1).Formula = "=COUNT(D2:D" & LR & ")"
TotalBilled = ws.Range("D" & ws.Rows.count).End(xlUp).Value
ws.Range("D" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("E" & ws.Rows.count).End(xlUp).Row
ws.Range("E" & LR + 1).Value = "TOTAL AMT INVOICED:"
ws.Range("E" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("F" & ws.Rows.count).End(xlUp).Row
ws.Range("F" & LR + 1).Formula = "=SUM(F2:F" & LR & ")"
TotalClients = ws.Range("F" & ws.Rows.count).End(xlUp).Value
ws.Range("F" & LR + 1).Cells.Interior.ColorIndex = 6



xlApp.DisplayAlerts = False
xlWB.SaveAs (filename)
xlWB.Close
xlApp.Quit

If Format(Now(), "MM/dd/yyyy") <> DateSerial(Year(Now()), Month(Now()), 1) Then

DoCmd.OutputTo acOutputQuery, "qryMONTHTODATEINVOICED", acFormatXLSX, filename2, False

Set xlApp = New Excel.Application
With xlApp
    .Visible = False
    Set xlWB = .Workbooks.Open(filename2, , False)
    Set ws = .Worksheets("qryMONTHTODATEINVOICED")

End With


LR = ws.Range("C" & ws.Rows.count).End(xlUp).Row
ws.Range("C" & LR + 1).Value = "TOTAL # OF INVOICES:"
ws.Range("C" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("D" & ws.Rows.count).End(xlUp).Row
ws.Range("D" & LR + 1).Formula = "=COUNT(D2:D" & LR & ")"
TotalBilled = ws.Range("D" & ws.Rows.count).End(xlUp).Value
ws.Range("D" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("E" & ws.Rows.count).End(xlUp).Row
ws.Range("E" & LR + 1).Value = "TOTAL AMT INVOICED:"
ws.Range("E" & LR + 1).Cells.Interior.ColorIndex = 6

LR = ws.Range("F" & ws.Rows.count).End(xlUp).Row
ws.Range("F" & LR + 1).Formula = "=SUM(F2:F" & LR & ")"
TotalClients = ws.Range("F" & ws.Rows.count).End(xlUp).Value
ws.Range("F" & LR + 1).Cells.Interior.ColorIndex = 6


xlApp.DisplayAlerts = False
xlWB.SaveAs (filename2)
xlWB.Close
xlApp.Quit

End If

    Set myOutlook = CreateObject("Outlook.Application")

    Dim newEmail As outlook.MailItem
    Set newEmail = myOutlook.CreateItem(olMailItem)

    Dim myAttachments As outlook.Attachments
    Set myAttachments = newEmail.Attachments

    With newEmail

        .Recipients.Add ("test@test.ORG")

        .Subject = "--- SYSTEM FUNCTION --- Daily Clients Invoiced in System"
        .Body = "Daily Clients Invoiced in System for " & Format(DateAdd("d", -1, Now()), "mm_dd_yyyy") & ""

    End With

    myAttachments.Add filename, olByValue
    myAttachments.Add filename2, olByValue
    newEmail.Send



    Set newEmail = Nothing
    Set myAttachments = Nothing
    Set myOutlook = Nothing

Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object

Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")

For Each oProc In cProc

'Rename EXCEL.EXE in the line below with the process that you need to Terminate.
'NOTE: It is 'case sensitive

If oProc.Name = "EXCEL.EXE" Then
  errReturnCode = oProc.Terminate()
End If
Next

End Function`

回答1:

After multiple attempts I was only able to get this working by creating a scheduled task that runs a macro that opens a form with the timer interval set to 10000 that checks the time and if it is a certain time run the functions.

Private Sub Form_Timer()
If TimeValue(Now()) > #7:00:00 AM# Then
    Me.TimerInterval = 0
    Call SendDailyInvoiceReport
    Call SendDailyClientsMailReport
    Call SendMonthlyClientsMailReport
    Call SendYearlyClientsMailReport
    DoCmd.Quit
End If
End Sub

来源：https://stackoverflow.com/questions/38205829/task-scheduler-will-not-run-macro