Check out some similar questions!

SoyJet · Mar 8, 2011, 08:39 AM

Scott, You've helped me before through All Experts. Please help me now, I'm at wits end

Need help with automating the sending of access reports at night.

I have several BAT files that run DISCOVERER exports to excel
I have a VBS that loops through all those exports to re-save in a compliant version
I have a VBS that runs several access subs to update the tables with the downloaded data
Finally, and here's where it goes awry
I have a VBS that runs a sub to OUTPUT a report, looping filter by slsman...
All these are bundled in a BAT so they run one after the other
This is inside a WS to make it run in the background, under Task Scheduler, at night..

In the VBS MIDNIGHT REPORTING, I include the Resume and Suspend for Express Click Yes.

It works fine, except that once the first report is open and ready to send, it bombs there.. it won't pass to Outlook, maybe because it has been idle?? \

In the VBS that calls this report sub, trying to overcome this, I included some code to open and display the inbox, but it didn't work, either..

Here's the vbs code, followed by the access function code:

Code:

option explicit

On Error resume Next

dim objFSO
dim objFile
Dim Log

dim accObj
DIM MyDb
dim MyArray
dim MyModule
Dim item


'added this outlook section to check if this would wake it up.  if it doesn't delete this outlook section thru
' where it sais error logging

Dim oOutlook
Dim oItems
Dim oFirst


'   Wake Outlook up from Idle

 Set oOutlook = GetObject("Outlook.Application")
 Set oItems = oOutlook.GetNameSpace("MAPI").GetDefaultFolder(6).Items.GetFirst()
 Set oFirst = oItems.GetFirst()
 oFirst.Display
 oFirst.Close

Set oFirst = Nothing
Set oItems = Nothing
Set oOutlook = Nothing



'   Error logging

Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Log = "C:\home\Network Development\Regional Assistants\BackEnds\DiscvrRepSched\reporting.log"


'   Open Access database
Const ERR_APP_NOTRUNNING = 429

MyDb = "C:\home\Network Development\Regional Assistants\Daily Task Management.mdb"

   Set accObj = GetObject(MyDb, "Access.Application")
'   If Access isn't running, create a new instance.
   If Err = ERR_APP_NOTRUNNING Then
     Set accObj= New Access.Application
	accObj.OpenCurrentDataBase MyDb
   End If



' ******** CHANGE TO CREATE DOUBLE ARRAYS FOR PATHS AS WELL AS DB NAMES OR SOMETHING.  
' ******** mAYBE A TABLE FIRST, AND FROM THERE THE ARRAY?


MyArray = Array("ReportingDailyStats")

'MyArray = Array("ReportingDailyStats", _
'		"...", _
'		)

For each item in MyArray
accObj.run item

'accObj.run "ReportingDailyStats"


Set objFile = objFSO.OpenTextFile(Log, ForAppending, True)
If Err.Number <> 0 Then
    objFile.Writeline "Access Reporting of " & item & " failed somewhere ! " & Now _
	& " " & Err.Number & " Error Description: " & Err.Description
    Err.Clear
Else
    objFile.Writeline "Access Reporting of " & item & " was completed " & Now
    Err.Clear
End If

objFile.Close

Next


accObj.CloseCurrentDatabase


'objFile.Close

' Clear memory

Set accObj = Nothing
Set objFSO = Nothing
Set objFile = Nothing

' ****************

'HERE'S THE ACCESS FUNCTION:

Option Compare Database

Public Sub ReportingDailyStats()


'this is the actual send access report loop
Dim strEmail As String
Dim rs As ADODB.Recordset
Dim strAssignee As String
Dim blnOK As Boolean
Dim msg As String
Dim strName As String
Dim strToList As String
blnOK = True

' *******CHECK HERE THE EMAILS....  IF NEED TO CHANGE... CREATE DISTRIB TABLE
strToList = "[email protected];[email protected]"

Set rs = New ADODB.Recordset
rs.Open "Select DISTINCT Assignee, EmailAddress from TblAssociates where State not like 'Sears' and [Reporting State] = 'Yes'", _
    CurrentProject.Connection, adOpenKeyset, adLockOptimistic

If rs.RecordCount > 0 Then

ResumeClickYes
rs.MoveFirst
While Not rs.EOF
strEmail = rs!emailaddress
strAssignee = rs!Assignee
msg = "Daily Performance Update for " & [strAssignee]

DoCmd.OpenReport "Daily Performance Update - Use", acViewPreview, , "[Assignee] = '" & strAssignee & "'"
DoCmd.SendObject acSendReport, , acFormatPDF, strEmail, , , msg, , False
DoCmd.Close acReport, "Daily Performance Update - Use"

rs.MoveNext

Wend
SuspendClickYes
rs.Close
Set rs = Nothing

End If

'this sends the full report to managers named in strToArray dimmed above
ResumeClickYes
DoCmd.SendObject acSendReport, "Daily Performance Update - Use", acFormatPDF, strToList, , , "Daily Performance Update", _
    "Please let me know if you see any inconsistencies, or the update dates do not fall within the last 12 hours.", 0
DoCmd.Close acReport, "Daily Performance Update - Use"
SuspendClickYes

'this is for saving the report, if preferred
'DoCmd.OutputTo acOutputReport, "Daily Performance Update - TESTJET", acFormatPDF, _
    "C:\home\Network Development\Regional Assistants\BackEnds\DiscvrRepSched\EMAIL\" _
        & "Daily Performance Update" & Format(Date, ShortDate) & ".pdf"

Exit_ReportingDailyStats:
    Exit Sub

Err_ReportingDailyStats:
    MsgBox Error$ & ": " & Err.Description
    SuspendClickYes
    Resume Exit_ReportingDailyStats

End Sub

ANY HELP IS GREATLY APPRECIATED!! I've got other reports that I'd like to automate once this one is working...

Thanks! Be my savior!

Jet

Check out some similar questions!

Add your answer here.