Fatal编程技术网
  • vba/
  • 多个MS Access数据库+；Outlook（VBA）在计划任务运行期间挂起

多个MS Access数据库+；Outlook（VBA）在计划任务运行期间挂起

vba ms-access outlook

多个MS Access数据库+；Outlook（VBA）在计划任务运行期间挂起,vba,ms-access,outlook,scheduled-tasks,Vba,Ms Access,Outlook,Scheduled Tasks,我创建了几个MS Access数据库，这些数据库连接到我公司的SQL server（MSSQL），执行计算，然后以电子邮件的形式导出结果。这些被设置为在一天中的特定时间通过windows任务计划程序运行。在您询问之前，我没有访问SQL server的权限，因此我无法创建任何存储过程或执行除读取之外的任何操作。它们在我桌下的台式计算机上运行，这是100%的时间（除了每周重新启动） 我遇到的问题是在MS Access中使用VBA来实际发送电子邮件。所有SQL和excel格式都按预期工作，但在电子邮件

我创建了几个MS Access数据库，这些数据库连接到我公司的SQL server（MSSQL），执行计算，然后以电子邮件的形式导出结果。这些被设置为在一天中的特定时间通过windows任务计划程序运行。在您询问之前，我没有访问SQL server的权限，因此我无法创建任何存储过程或执行除读取之外的任何操作。它们在我桌下的台式计算机上运行，这是100%的时间（除了每周重新启动）

我遇到的问题是在MS Access中使用VBA来实际发送电子邮件。所有SQL和excel格式都按预期工作，但在电子邮件离开发件箱之前，我遇到了Access关闭Outlook的问题。试图让访问等待或休眠直到发送电子邮件，这会导致程序无法正常挂起。我非常感谢您就如何解决此问题提供的任何帮助。

谢谢，请看下面。在这一点上，我最好的猜测是，当两个独立的Access数据库试图同时使用它们时，我使用的sleep或wait方法会被卡住。我怀疑这是因为当我独立地运行每个进程进行调试时，它们能够毫无问题地运行

Windows任务计划程序： 上午6:30（任务1）（运行时间2分钟）-Access打开internet页面，提取数据，在excel中设置格式，并保存到网络驱动器，在该驱动器中，其他程序（不是我编写的）在7:00提取数据并上载到SQL server。这是第一个计划任务，很少出现问题

上午7:30（任务2）（运行时间5分钟）-Access连接到SQL，运行查询，将结果导出到excel文件（无电子邮件）

上午7:35（任务3）（运行时间1.5小时）-Access连接到SQL，运行大量非常大的查询，然后将文件导出到excel并尝试发送电子邮件。这一个在创建文件时有问题，当我尝试发送电子邮件时，它要么在我打开outlook之前一直位于发件箱中，要么在创建文件时发送电子邮件有问题

上午8:00（任务4）（运行时间3分钟）-Access连接SQL、运行查询、发送电子邮件。通常没有问题，但偶尔电子邮件会卡在发件箱中

上午8:00（任务5）（运行时间30分钟）-Access连接SQL，运行查询，从任务2获取文件，发送电子邮件

对于所有任务，以下是设置：

  • 仅当用户已登录时运行
  • 以最高权限运行
  • 操作-启动程序（.bat）
.bat文件具有以下常规格式：

@echo on
cscript SCRIPT_NAME.vbs

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
.vbs文件具有以下常规格式：

@echo on
cscript SCRIPT_NAME.vbs

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
Outlook VBA模块 我怀疑我遇到的问题与我发送电子邮件的方式有关，因为即使没有发送电子邮件，文件输出也正确。另外，当我独立测试每个.bat时，代码能够正确运行。下面请找到我用来发送电子邮件的代码

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 = "email1@example.com;email2@example.com, 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 = "group_mailbox@example.com"
    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

选项比较数据库
私有声明子睡眠库“kernel32”（ByVal-dwms长度）
函数sendToOutlook（sWhNo作为字符串）
像线一样变暗
作为整数的Dim n
n=FreeFile（）
打开“C:\PATHNAME\logfile.txt”以输出为#n
s=“你好，世界！”
印刷品
Dim-XL作为Excel.Application
将工作簿设置为Excel.工作簿
Dim fileNameLocation作为字符串
Dim olApp作为Outlook.Application
将SP设置为Outlook.Inspector
以Outlook.MailItem的形式发送邮件
作为Outlook.Attachments的Dim olAttachments
作为字符串的Dim subjectStr
将SWH字符串设置为字符串
选择案例sWhNo
案例“此处案例陈述”
subjectStr=“城市名称”
sWhString=subjectStr
“更多案例
结束选择
打印#n，主题str
打印n，sWhString
toStr=”email1@example.com;email2@example.com等”
bccStr=“”
subjectStr=subjectStr&“&”exportTime&“报告名”
fileLocation=“C:\TASK2\u文件路径”
XlFileFormatStr=“.xlsx”
印刷品
打印#n，ccStr
打印#n，主题str
打印#n，文件位置
打印#n，XlFileFormatStr
尺寸qryRange1为Excel.Range
作为字符串的Dim sFileLocation
将sFileName设置为字符串
Dim sFullFileNameLoc作为字符串
Dim sMonthNum作为字符串
作为字符串的Dim sDayNum
sFileLocation=“C:\CURRENT\u TASK\u PATHNAME”
sDayNum=天（日期）
如果sDayNum-10<0，则sDayNum=“0”&天（日期）
sMonthNum=月（日）
如果sMonthNum-10<0，则sMonthNum=“0”&月份（日期）
sFileName=sWhNo&“报告名”&“年份（日期）&”sMonthNum&sDayNum&“.xlsx”
打印文件名
sFullFileNameLoc=sFileLocation&sFileName
打印#n，sFullFineNAmeLoc
Set XL=CreateObject（“Excel.Application”）
设置XlBook=XL.Workbooks.Open（sFullFileNameLoc）
四十、 DisplayAlerts=False
四十、 AskToUpdateLinks=False
四十、 EnableEvents=False
四十、 可见=真
设置qryRange1=XlBook.Sheets（“SHEET_NAME”）.Range（XlBook.Sheets（“SHEET_NAME”）.Cells（1,1）.Address（），XlBook.Sheets（“SHEET_NAME”）.Cells（11,14）.Address（））
出错时继续下一步
Set olApp=newoutlook.Application
如果错误号=429，则
打印“429！！！”
调试。打印“429！！！”
设置olApp=GetObject（，“Outlook.Application”）
设置olInsp=olApp.ActiveInspector
设置olMail=olApp.CreateItem（olMailItem）
设置olaattachments=olMail.Attachments
转到LBL_关闭
如果结束
设置olInsp=olApp.ActiveInspector
设置olMail=olApp.CreateItem（olMailItem）
设置olaattachments=olMail.Attachments
olMail.SentOnBehalfOfName=“组_mailbox@example.com"
打印“第429号”
添加（“C:\TASK2\u FILEPATH\”&exportFileNameGlobal\u FINAL）
LBL_关闭：
设置qryRange1=XlBook.Sheets（“SHEET_NAME”）.Range（XlBook.Sheets（“SHEET_NAME”）.Cells（1,1）.Address（），XlBook.Sheets（“SHEET_NAME”）.Cells（11,14）.Address（））
与奥尔梅尔
.To=toStr
.CC=ccStr
.BCC=bccStr
主语，主语