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