CODEWITHSUNDEEP
vbaexcel
Merni
Merni

Reputation: 2912

I can't combine unlock vbaproject and write in ThisWorkbook

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

Down below is my function. I want to unlock vbaproject and write in ThisWorkbook. For some reason when I incorporate the above 4 lines (at **), the workbook is not unlocked and the line "Hej jag kan spara detta" is not applied to ThisWorkbook. However, without these 4 rows, the workbook is unlocked. And if the workbook is unlocked before running the code, the same 4 lines also work. What is wrong?

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

Upvotes: 1

Views: 930

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149295

Two things

  1. Filename = Dir() should be before the loop and not before those 4 lines. Else you will get a different Filename.

  2. Also the 4 lines should be inside your If Filename <> "merni.xlsm" Then Condition

Also you might want to close the workbook before you open the new one. Else you will have lot of workbooks open :)

FOLLOWUP

You are not opening the workbook but setting it to the current workbook every time and hence it is not working. I have tested the code below and it works just fine.

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

Upvotes: 1

Related Questions