programar - vba para access 2013

Múltiples bases de datos MS Access+Outlook(VBA) colgando durante la ejecución de tareas programadas

Question

He creado varias bases de datos de MS Access que se conectan al servidor SQL de mi empresa (MSSQL), realizo cálculos y luego exporto los resultados en forma de correo electrónico. Están configurados para ejecutarse a través del programador de tareas de Windows en un momento determinado del día. Antes de preguntar, no tengo acceso al servidor SQL, así que no puedo crear ningún procedimiento almacenado ni hacer otra cosa que no sea leer. Se ejecutan en una computadora de escritorio debajo de mi escritorio que está en el 100% del tiempo (que no sea un reinicio semanal).

El problema que estoy teniendo es usar VBA en MS Access para enviar realmente los correos electrónicos. Todos los formatos de SQL y Excel funcionan según lo previsto, pero me encontré con el tema de Access que cierra Outlook antes de que el correo electrónico salga de mi bandeja de salida. Los intentos de hacer que Access espere o duerma hasta que se envíen correos electrónicos están causando que el programa cuelgue indefinidamente. Agradecería enormemente cualquier ayuda que pueda brindar sobre cómo resolver este problema.

Gracias y por favor mira a continuación. Mi mejor conjetura en este punto es que los métodos de espera o de espera que he usado se quedan bloqueados cuando dos bases de datos de acceso independientes intentan usarlos al mismo tiempo. Sospecho que esto porque cuando ejecuto cada proceso de forma independiente para depurar, pueden ejecutarse sin problemas.

Programador de tareas de Windows:

6:30 AM (Tarea 1) (Tiempo de ejecución 2 minutos): Access abre una página de Internet, extrae datos, formatea en Excel y los guarda en una unidad de red donde un programa diferente (no escrito por mí) recoge los datos a las 7:00 y carga al servidor SQL. Esta es la primera tarea programada y rara vez tiene problemas.

7:30 a.m. (Tarea 2) (tiempo de ejecución de 5 minutos): el acceso se conecta a SQL, ejecuta consultas y exporta los resultados al archivo de Excel (sin correo electrónico).

7:35 AM (Tarea 3) (Tiempo de ejecución 1.5 horas): el acceso se conecta a SQL, ejecuta muchas consultas muy grandes, luego exporta el archivo a excel e intenta enviar correos electrónicos. Este tiene problemas donde se crea el archivo y cuando intento enviarlo por correo electrónico, o se sienta en la bandeja de salida hasta que abro Outlook o se crea un archivo y tiene problemas para enviar el correo electrónico.

8:00 AM (Tarea 4) (Tiempo de ejecución 3 minutos) - El acceso se conecta a SQL, ejecuta consultas y envía correos electrónicos. Por lo general, no tiene problemas, pero a veces los correos electrónicos se atascan en la Bandeja de salida.

8:00 a.m. (Tarea 5) (Tiempo de ejecución 30 minutos): el acceso se conecta a SQL, ejecuta consultas, obtiene archivos de la tarea 2 y envía correos electrónicos.

Para todas las tareas, estas son las configuraciones:

• Ejecutar solo cuando el usuario está conectado.
• Ejecutar con los privilegios más altos.
• Acción - Comience un programa (.bat)

Los archivos .bat tienen este formato general:

@echo on
cscript SCRIPT_NAME.vbs

Los archivos .vbs tienen este formato general:

Dim oAccessApp
Set oAccessApp = createObject("Access.Application")
oAccessApp.OpenCurrentDataBase("C:/PATHNAME.accdb")
oAccessApp.Visible = True
oAccessApp.Run "VBA_FUNCTION_NAME", "PARAMETERS"
oAccessApp.Application.Quit
Set oAccessApp = nothing

Módulo de Outlook VBA

Sospecho que el problema que estoy teniendo está relacionado con la forma en que estoy enviando los correos electrónicos porque los archivos salen correctamente, incluso si los correos electrónicos no se envían. Además, el código puede ejecutarse correctamente cuando pruebo cada .bat de forma independiente. A continuación, encuentre mi código que utilizo para enviar los correos electrónicos.

Option Compare Database
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function sendToOutlook(sWhNo As String)
Dim s As String
Dim n As Integer
n = FreeFile()
Open "C:/PATHNAME/logfile.txt" For Output As #n
s = "Hello, world!"
Print #n, s
Dim XL As Excel.Application
Dim XlBook As Excel.Workbook
Dim fileNameLocation As String
Dim olApp As Outlook.Application
Dim olInsp As Outlook.Inspector
Dim olMail As Outlook.MailItem
Dim olAttachments As Outlook.Attachments
Dim subjectStr As String
Dim sWhString As String
Select Case sWhNo
Case "CASE_STATEMENTS_HERE"
subjectStr = "CITY_NAME"
sWhString = subjectStr
''more cases
End Select
Print #n, subjectStr
Print #n, sWhString
toStr = "[email protected];[email protected], etc"
bccStr = ""
subjectStr = subjectStr & "_" & exportTime & " REPORT_NAME"
fileLocation = "C:/TASK2_FILEPATH"
XlFileFormatStr = ".xlsx"
Print #n, toStr
Print #n, ccStr
Print #n, subjectStr
Print #n, fileLocation
Print #n, XlFileFormatStr
Dim qryRange1 As Excel.Range
Dim sFileLocation As String
Dim sFileName As String
Dim sFullFileNameLoc As String
Dim sMonthNum As String
Dim sDayNum As String
sFileLocation = "C:/CURRENT_TASK_PATHNAME/"
sDayNum = Day(Date)
If sDayNum - 10 < 0 Then sDayNum = "0" & Day(Date)
sMonthNum = Month(Date)
If sMonthNum - 10 < 0 Then sMonthNum = "0" & Month(Date)
sFileName = sWhNo & "_REPORT_NAME_" & Year(Date) & sMonthNum & sDayNum & ".xlsx"
Print #n, sFileName
sFullFileNameLoc = sFileLocation & sFileName
Print #n, sFullFineNAmeLoc
Set XL = CreateObject("Excel.Application")
Set XlBook = XL.Workbooks.Open(sFullFileNameLoc)
XL.DisplayAlerts = False
XL.AskToUpdateLinks = False
XL.EnableEvents = False
XL.Visible = True
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
On Error Resume Next
Set olApp = New Outlook.Application
If Err.Number = 429 Then
Print #n, "429!!!"
Debug.Print "429!!!"
Set olApp = GetObject(, "Outlook.Application")
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
GoTo LBL_CLOSE
End If
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
olMail.SentOnBehalfOfName = "[email protected]"
Print #n, "NO 429"
olAttachments.Add ("C:/TASK2_FILEPATH/" & exportFileNameGlobal_FINAL)
LBL_CLOSE:
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
With olMail
.To = toStr
.CC = ccStr
.BCC = bccStr
.Subject = subjectStr
.HTMLBody = "Please find attached blah blah blah " & sWhString & vbCrLf & RangetoHTML(qryRange1, XL)
.Display
End With
Dim olAppNS As Outlook.Namespace
Dim olFolder As Outlook.Folder
With olMail
.Send
End With
XlBook.Close
XL.Quit
Set XlBook = Nothing
Set XL = Nothing
olApp.Quit
Set olApp = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olAttachments = Nothing
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
Dim mySyncObject As Outlook.SyncObject
Dim sync As Outlook.SyncObject
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
For i = 1 To mySyncObjects.Count
Set sync = mySyncObjects(i)
sync.Start
Next
Do While olFolder1.Items.Count > 0
Sleep 10000
Loop
Close #n
Sleep 60000
olApp1.Quit
Set olApp1 = Nothing

Indique lo que estoy haciendo mal que está causando el acceso al bloqueo y cómo debería solucionarlo. Agradezco mucho cualquier ayuda que pueda brindar. Gracias.

Answer 1

Debido a la naturaleza de las aplicaciones de Office, supongo que está durmiendo su único hilo y literalmente no puede intentar enviar el correo mientras se está comiendo o tirando todo su tiempo de CPU. En lugar de sondear el buzón y tratar de esperar manualmente que se envíen los elementos de correo, intente usar ese SyncObject que ya ha creado para registrar un controlador de eventos.

Aquí hay una idea de lo que quiero decir. El siguiente es un nuevo módulo de clase:

Dim WithEvents mySync As Outlook.SyncObject
Dim myApp As Outlook.Application
Sub Close_After(ByRef toClose As Outlook.Application, ByRef newSync As Outlook.SyncObject)
Set myApp = toClose
Set mySync = newSync
mySync.Start
End Sub
Private Sub mySync_SyncEnd()
myApp.Quit
End Sub

Esto envuelve un SyncObject y le da un controlador de eventos que cerrará la aplicación actual.

Y en su código de llamada, haga algo como:

Dim syncClose As New SyncHandler '' Scope to module so we don''t lose the reference
Function sendToOutlook(sWhNo As String)
'' ...
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
'' ...
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
syncClose.Close_After olApp1, (mySyncObjects(1))
End Function

Esto pasa el primer SyncObject a su clase, que inicia la sincronización y, cuando se completa la sincronización, cierra la aplicación SyncObject pasada. Si (por alguna razón) tiene más de un SyncObject que desea esperar tendrá que reestructurar para asegurarse de que todos hayan terminado antes de cerrar la aplicación. Sin embargo, el concepto será el mismo: compilar envolturas que registren controladores de eventos (o una gran clase contenedora que maneje los eventos de muchos SyncObject individuales), pero agregue una verificación de que todas las sincronizaciones deben completarse antes de que se cierre la Application .

Answer 2

Si está utilizando Exchange, puede desactivar el modo en caché: el mensaje se enviará inmediatamente. De lo contrario, no tiene más remedio que iniciar la sincronización ( SyncObject.Start ) y esperar a que se SyncObject.SyncEnd evento SyncObject.SyncEnd .

Answer 3

Aunque indicas que deseas usar Outlook, descubrí que era más fácil no confiar en Outlook para enviar correos electrónicos, así que he usado CDO para una aplicación muy similar. Ver el correo electrónico usando Access y VBA sin MAPI