发送密钥不发送外部办公室应用程序

Question

所以我正在工作的项目，我有一个 VBS 脚本，我每天使用 Windows 任务计划程序自动运行。 VBS 脚本调用此宏。但是，我在 Outlook 中的电子邮件总是弹出一个我无法摆脱的弹出窗口（在我的组织中不是一个选项。）。我也无法在弹出窗口中调用“发送”键对象，因为这些对象位于访问受限目录中。所以我尝试使用发送键来简单地发送回车键来点击弹出窗口。

我的问题是我的 sendkeys 代码只能部分工作。它发送回车键，但它只在我在 MS Office 应用程序中时发送回车键，但不会发送到弹出窗口。有什么想法吗？

Sub Mail_ActiveSheet()

' Refreshes webquery
Application.Worksheets("Sheet1").Range("A1").QueryTable.Refresh BackgroundQuery:=False
' Enters Title Comments in Cell M2
Range("$M$2").Value = "Comments"
' Enters formula in column M
Range("$M$3").Formula = Range("G3") & (",") & Range("L3")

' Draws formula to the end of the workbook
Dim Lastrow As Long

Application.ScreenUpdating = False

Lastrow = Range("L" & Rows.Count).End(xlUp).Row
Range("M3:M" & Lastrow).Formula = "=G3&"",""&L3"
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True



' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim WshShell As Object


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    ' Next, copy the sheet to a new workbook.
    ' You can also use the following line, instead of using the ActiveSheet object,
   ' if you know the name of the sheet you want to mail :
    ' Sheets("Sheet5").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    ' Determine the Excel version, and file extension and format.
    With Destwb
     Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".csv": FileFormatNum = 6
        Case 52:
            If .HasVBProject Then
             FileExtStr = ".csv": FileFormatNum = 6
            Else
            FileExtStr = ".csv": FileFormatNum = 6
      End If
    Case 56: FileExtStr = ".csv": FileFormatNum = 6
    Case Else: FileExtStr = ".csv": FileFormatNum = 6
    End Select

    End With

    ' You can use the following statements to change all cells in the
   ' worksheet to values.
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        With OutMail
            .To = "myemail@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "Daily File"
            .Body = "Daily File"
            .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Application.Wait (Now + TimeValue("0:00:04"))
    ActiveWindow.Activate
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.SendKeys "~", True
    WshShell.SendKeys ("{NUMLOCK}")

End Sub

Answer 1

我决定从我的 VBA 宏中删除最后一段代码，并创建一个 VBScript 来输入发送键。最后我有 2 个 VBScripts（一个调用我的 MACRO 来运行，然后一个运行我的发送键命令）。这些 VBScript 都是从批处理 (.bat) 文件中调用的。

这是我删除的代码：

Application.Wait (Now + TimeValue("0:00:04"))
ActiveWindow.Activate
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "~", True
WshShell.SendKeys ("{NUMLOCK}")

那么这就是放置在sendkeys.vbs VBSCRIPT中的内容：

Set oShell = WScript.CreateObject("WScript.Shell")
WScript.Sleep 9000
 oShell.SendKeys "{ENTER}"

那么这是我的macro.vbs VBScript：

Set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")

Set myxlApplication = CreateObject("Excel.Application")
myxlApplication.Visible = False
Set myWorkBook = myxlApplication.Workbooks.Open( "C:\Users\username\Desktop\macro.xlsm" ) 'Change to the actual workbook that has the Macro
myWorkBook.Application.Run "Module1.Mail_ActiveSheet" 'Change to the Module and Macro that contains your macro
myxlApplication.Quit

然后我只是从一个批处理文件中调用这两个 VBScript：

START C:\Users\username\Desktop\macro.vbs
START C:\Users\username\Desktop\sendkeys.vbs

然后我所要做的就是运行批处理文件，它就像一个魅力一样工作。

感谢您的建议！