我无法将解锁vbaproject和写在ThisWorkbook中

Set wb = Workbooks(Filename) Set codeModule = wb.VBProject.VBComponents("ThisWorkbook").codeModule codeModule.InsertLines 3, "Hej jag kan spara detta" wb.Save 

下面是我的function。 我想解锁vbaproject并在ThisWorkbook中写入。 由于某些原因,当我合并上述4行(在**)时,工作簿未解锁,“Hej jag kan spara detta”行不适用于ThisWorkbook。 但是,没有这4行,工作簿被解锁。 如果在运行代码之前解锁工作簿,同样的4行也可以工作。 哪里不对?

 Sub merniplusplus() Dim path As String Dim Filename As Variant Dim wb As Workbook Dim CodeModule As Variant path = "C:\Merni\" Filename = Dir(path & "*.xls") Do While Filename <> "" If Filename <> "merni.xlsm" Then UnprotectPassword Workbooks(Filename), "2lbypo" Set wb = ActiveWorkbook Set CodeModule = wb.VBProject.VBComponents("ThisWorkbook").CodeModule CodeModule.InsertLines 3, "Hej jag kan spara detta" wb.Save End If Filename = Dir() Loop End Sub Sub UnprotectPassword(wb As Workbook, ByVal projectPassword As String) Dim currentActiveWb As Workbook If wb.VBProject.Protection <> 1 Then Exit Sub End If wb.Unprotect "poWorkbook" Set currentActiveWb = ActiveWorkbook wb.Activate SendKeys "%{F11}" SendKeys "^r" ' Set focus to Explorer SendKeys "{TAB}" ' Tab to locked project SendKeys "~" ' Enter SendKeys projectPassword SendKeys "~" ' Enter If (wb.VBProject.Protection = vbext_pp_locked) Then MsgBox ("failed to unlock") End If currentActiveWb.Activate End Sub 

两件事情

  1. Filename = Dir()应该在循环之前,而不是在这四行之前。 否则你会得到一个不同的Filename

  2. 此外,4行应该在你的If Filename <> "merni.xlsm" Then条件

也可以在打开新工作簿之前closures工作簿。 否则你将有很多工作簿打开:)

跟进

您不打开工作簿,但每次都将其设置为当前工作簿,因此它不起作用。 我已经testing了下面的代码,它工作得很好。

 Sub merniplusplus() Dim path As String, Filename As String Dim wb As Workbook Dim CodeModule As Variant path = "C:\Merni\" Filename = Dir(path & "*.xls") Do While Filename <> "" If Filename <> "merni.xlsm" Then Set wb = Workbooks.Open(path & Filename) UnprotectPassword wb, "2lbypo" Set CodeModule = wb.VBProject.VBComponents("ThisWorkbook").CodeModule CodeModule.InsertLines 3, "Hej jag kan spara detta" wb.Close SaveChanges:=True End If Filename = Dir Loop End Sub