尝试发送到 Excel 加载项时 Excel VBA SendKeys 不起作用答案

【问题标题】：Excel VBA SendKeys not working when trying to Send to Excel Add-In尝试发送到 Excel 加载项时 Excel VBA SendKeys 不起作用
【发布时间】：2017-01-18 12:59:28
【问题描述】：

简介。：在我的公司，我们在 Excel 中安装了一个安全插件，阻止我们在不输入所需参数的情况下保存新的 Excel 工作簿。

挑战：使用SendKeys 发送此 Excel 插件所需的密钥。

问题：当加载项屏幕弹出时（如下面的屏幕截图所示），代码似乎没有继续到这一行：SendKeys " ", True。

我的代码（相关部分）

编辑 1：下面的代码在 For 循环内，我正在将每个用户的过滤数据库导出给该用户。所以每次我尝试为其中一个用户保存文件时，我都会遇到加载项（我需要在For 循环中“绕过”它）。

' sort the PM's workbook , hide source data    
Application.DisplayAlerts = False
NewWB.Sheets("Combined").Visible = False
NewWB.Sheets("Sheet3").Delete
NewWB.SaveAs "Budget usage - " & Year(Date) & "-" & Month(Date - 30) & " " & PMList(r)

Dim i    As Long

SendKeys " ", True ' <-- it doesn't get to this line when the Excel Add-In pops up
For i = 1 To 3
    SendKeys "+{DOWN}", True
Next i
SendKeys "{ENTER}", True
For i = 1 To 4
    SendKeys "+", True
Next i
SendKeys "{ENTER}", True

【问题讨论】：

您可以访问插件的代码吗？你能改一下代码，把表格显示为UserForm1.Show vbModeless吗？
@Vityata 不，我希望 :)
插件是否有任何公共访问权限，所以MyAddIn. 那么在点后intellisense 说什么，可以设置为MyAddin.Value=ValueToSet
@Nathan_Sav 似乎没有，当我使用For Each ad In Application.AddIns 遍历所有加载项时，它不存在。
它可能是一个 COM 插件写的 o/s VBA。

标签： vba excel add-in sendkeys

【解决方案1】：

Public Sub TryMe()

    Dim s           As String
    Dim sPath       As String
    Dim sTitle      As String: sTitle = "runme.vbs"

    s = "Set WshShell = WScript.CreateObject(""WScript.Shell"")" & vbNewLine & _
        "WScript.Sleep 6000" & vbNewLine & _
        "WshShell.SendKeys ""+{TAB}""" & vbNewLine & _
        "WshShell.SendKeys ""~"""

    CreateObject("Scripting.FileSystemObject").createtextfile(sTitle).write s
    sPath = "wscript " & ThisWorkbook.Path & "\runme.vbs"
    Shell sPath, vbNormalFocus

End Sub

@Pierre - 你的想法是写这样的东西^^？

然后在调用表单之前调用它，然后在某个地方删除它？最初我以为你不会在任何地方创建文件，但现在我已经尝试过了，我注意到了。它应该可以工作。

【讨论】：

谢谢，你的想法是在 VBA 中实际设置 VBS 的内容，最重要的是保留vbNormalFocus

【解决方案2】：

看起来您的插件在保存事件之前正在下沉应用程序工作簿，因此允许保存的快速修复方法是再次下沉它，因此在您的代码中，具有以下内容

在一个普通的模块中有以下内容

Public cResink As clsResinkApplication

有一个名为 clsResinkApplication 的类，该类的代码如下

Private WithEvents resinkApp As Excel.Application

Public Sub init2(appToResink As Excel.Application)
    Set resinkApp = appToResink
End Sub
Private Sub resinkApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveWorkbook.SaveAs "test.xlsx"
End Sub

然后在打开的工作簿中你可以有以下内容

Private Sub Workbook_Open()

Set cResink = New clsResinkApplication
cResink.init2 Application

End Sub

这应该在加载项之前转移到您的保存槽。

【讨论】：

感谢您的帮助，我最终使用了 VBScript，但我想知道我可以循环通过 AddIns :)

【解决方案3】：

您启动插件弹出窗口的事实“冻结”了代码。我不知道如何在 VBA 中异步执行此操作（现在我开始使用 VB.NET，我对这些事情感觉好多了！）。我能想到的最好的是： - 将一些代码保存在临时文件（例如 temp.vbs）中并在启动表单之前运行它：

Dim s$
s = "Set WshShell = WScript.CreateObject(""WScript.Shell"")" & vbNewLine & _
    "WScript.Sleep 6000" & vbNewLine & _
    "WshShell.SendKeys ""+{TAB}""" & vbNewLine & _
    "WshShell.SendKeys ""~"""
CreateObject("Scripting.FileSystemObject").createtextfile(FileName).write s
shell(filename)

【讨论】：

我也有同样的想法（但我的想法有点笨拙，将脚本放在一个单独的文件中并从 VBA 中调用它）！
@Pierre 不确定我完全理解将它放在代码中的哪个位置，上面的这一部分在 For 循环内，我正在为每个项目经理保存多个文件。
@Vityata ：我的也很烂，只是“干净”，因为您可以在使用后删除 VBS
@ShaiRado ：您一劳永逸地创建了 VBS 文件。每次您必须在表单上按“enter”时，在打开表单之前运行 VBS。然后在表单关闭后，你再次进入你的 VBA
@Pierre 我要回家了，待会在家里试试（如果我的孩子愿意的话）

【解决方案4】：

我要感谢 @Vityata 和 @Pierre 提出使用 VBScript 的想法，以及在 VBA 代码中编写 VBScipt 的内容。

我最终做的是：

1.在调用我的保存之前添加了Call WShellSendKeys。

'========== Call the VBScript to run a Shell to send to Keys in the background ======
Call WShellSendKeys        
NewWB.SaveAs "Budget usage - " & Year(Date) & "-" & Month(Date - 30) & " " & PMList(r)

2. 检查 VBSciprt 是否已经存在，如果不存在，则创建它。

Public Sub WShellSendKeys()

Dim wsh         As Object
Dim objFile     As Object
Dim objFSO      As Object

Set wsh = VBA.CreateObject("WScript.Shell")

If Dir(VBScrPath) <> "" Then  ' <-- VBS file name already exits in folder >> there's no need to re-create it, just run it
    ' Run Shell
    wsh.Run "wscript " & Chr(34) & VBScrPath & Chr(34), vbNormalFocus
Else ' VBS file name doesn't exits in folder >> create it
    Call WriteToVBS
    wsh.Run "wscript " & Chr(34) & VBScrPath & Chr(34), vbNormalFocus
End If

End Sub

3。另一个使用 SendKeys 创建 VBScript 的 Sub。

Sub WriteToVBS()

Dim objFile     As Object
Dim objFSO      As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(VBScrPath, 8, True)

' --- Text to write into the VBScript file ---
objFile.WriteLine ("Option Explicit")
objFile.WriteLine ("")
objFile.WriteLine ("Dim WshShell")
objFile.WriteLine ("Dim i")
objFile.WriteLine ("")
objFile.WriteLine ("Set WshShell = CreateObject(""WScript.Shell"")")
objFile.WriteLine ("WScript.Sleep(4000)")
objFile.WriteLine ("")
objFile.WriteLine ("WshShell.SendKeys ""{R}"",True")
objFile.WriteLine ("WScript.Sleep(1000)")
objFile.WriteLine ("For i = 1 To 2")
objFile.WriteLine ("WshShell.SendKeys ""{ENTER}"",True")
objFile.WriteLine ("WScript.Sleep(1000)")
objFile.WriteLine ("Next")

objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

End Sub

【讨论】：