Question

发送密钥以解锁VBA项目

我在宏观写作方面有点先进，但是这个网站都是自学成才，我不完全理解大图片

我正在尝试创建一个Excel电子表格，它将更新另一个具有受密码保护的VBA项目的Excel电子表格的VBA代码。我正在使用SendKeys解锁VBA项目。我还通过编写脚本来关闭所有打开的excel文档来解决SendKey缺陷。

我编写的所有代码都是自己编写的，但是当我尝试将它组合起来时，SendKey宏将密码放在其他代码行中：

这有效：

Sub UnprotectProject()
 With Application
 .SendKeys "%{F11}", True
 .SendKeys "^r", True
 .SendKeys "~", True
 .SendKeys "password", True
 .SendKeys "~", True
 End With
 End Sub

这会在其他VBA代码中插入密码：

Sub UnprotectProject()
 With Application
 .SendKeys "%{F11}", True
 .SendKeys "^r", True
 .SendKeys "~", True
 .SendKeys "password", True
 .SendKeys "~", True
 End With
 Application.VBE.MainWindow.Visible = False
 End Sub

更新

除了第二个例子中的以下行

之外，两组代码都是相同的

Application.VBE.MainWindow.Visible = False

我正在尝试编写的完整代码有五个任务，我为每个任务创建了一个宏，然后另一个宏来运行五个宏。每个宏在独立运行时执行预期的工作。但是，当我尝试运行组合各个任务的宏时，带有发送序列的宏失败，而不是解锁VBA项目，它将密码粘贴在一个单独的任务宏的代码中这是五项任务

打开（打开要更改的工作簿）
取消保护VBA项目
更新VBA代码
更新工作表
另存新版

这是我编写的用于运行各个任务的宏 Sub UsernameCheck（）

lastRow = Sheets("update").Range("I" & Rows.count).End(xlUp).Row
Uname = Environ("Username")
Set aCell = Sheets("update").Range("I4:I" & lastRow).Find(What:=Uname, MatchCase:=False)
If aCell Is Nothing Then
    MsgBox ("Not an Authorised User")
    Else
    Open_1
    UnprotectProject
    ChangeDateAddUserCheck
    UpdateDashBoard
    Save

End If

End Sub

这是我用来编辑宏

Sub ChangeDateAddUserCheck()
  Dim VBComp As VBIDE.VBComponent
  Dim CodeMod As VBIDE.CodeModule
  Dim S As String
  Dim LineNum As Long

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2")
  'Delete
  VBComp.CodeModule.DeleteLines 15, 4
  'add Code
  Set CodeMod = VBComp.CodeModule
  LineNum = 15
  S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _
      "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) =      UCase(Environ(""Username"")) Then" & vbCrLf & _
      "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _
      "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _
     "End If"
  CodeMod.InsertLines LineNum, S
End Sub

密码正在上面的代码中粘贴在下面的代码行之间，但我认为这更多地与宏在VBA编辑器中的位置有关

Dim LineNum As Long

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2")

Answer 1

试试这个。至少对我来说，暗示在你的评论中：

更改宏的代码不起作用，除非它们在同一个excel实例中

我对其进行了修改以处理Excel的不同的实例，这在技术上可能是必需的。我在过去使用VBE可扩展性观察了一些不稳定的事情，例如在运行时在执行模块中插入文本（基本上就是你所描述的）。

我之前也注意到了一些时序问题，因为SendKeys方法的“等待”参数没有等待，所以我还使用WinAPI Sleep函数在{之后引入半秒滞后{1}}来电。

注意：您需要修改其他功能以明确接收SendKeys工作簿参数，并将引用从wb更改为ActiveWorkbook等。（查看我如何将wb更改为ActiveWorkbook.VBProject等等。）

wb.VBProject

Pics还是没有发生：

在这里，您可以看到您的函数Option Explicit Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const slp As Long = 500 Sub Main() Dim wb As Workbook Dim xlApp As Application Call Open_1("C:\debug\stack\protected.xlsm", xlApp, wb) Call UnprotectProject(xlApp) Call ChangeDateAddUserCheck(wb) Set wb = Nothing Set xlApp = Nothing End Sub Sub Open_1(filename$, xlApp As Excel.Application, wb As Workbook) Set xlApp = CreateObject("Excel.Application") Set wb = xlApp.Workbooks.Open(filename) xlApp.Visible = True End Sub Sub UnprotectProject(xlApp As Object) With xlApp .SendKeys "%{F11}", True Sleep slp .SendKeys "^r", True Sleep slp .SendKeys "~", True Sleep slp .SendKeys "password", True Sleep slp .SendKeys "~", True Sleep slp End With End Sub Sub ChangeDateAddUserCheck(wb As Workbook) Dim VBComp As Object 'VBIDE.VBComponent Dim CodeMod As Object 'VBIDE.CodeModule Dim S As String Dim LineNum As Long Set VBComp = wb.VBProject.VBComponents("Module2") 'Delete VBComp.CodeModule.DeleteLines 15, 4 'add Code Set CodeMod = VBComp.CodeModule LineNum = 15 S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _ "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) = UCase(Environ(""Username"")) Then" & vbCrLf & _ "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _ "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _ "End If" CodeMod.InsertLines LineNum, S End Sub已将ChangeDateAddUserCheck代码字符串引入我的工作簿S：

<强>随访：

我在Protected.xlsm!Module2子广告中声明了wb和xlApp。然后将这些对象传递给Main()过程，该过程将打开新的Excel和指定的工作簿路径。

然后，需要对此Open_1或wb个对象（例如xlApp）进行操作的任何其他子例程将进行修改，以便它接受工作簿对象，例如：< / p>

ChangeDateAddUserCheck

同样，修改Sub ChangeDateAddUserCheck(wb As Workbook)签名以使其接受UnprotectProject对象：

xlApp

我如何引用此宏所存在的工作簿

与我的代码一样，Sub UnprotectProject(xlApp As Object)的范围限定为wb过程（Main也是如此）。如果您需要其他过程来处理这些对象，请按照上述示例将它们传递给这些过程。你基本上是在说，“[某些程序]现在将采用这个xlApp对象并用它做点什么”

发送密钥以解锁VBA Project Excel 2013

1 个答案: