Pages

Monday, February 24, 2014

Macro to unprotect excel sheet

sub MyMacro()
                        Dim i As Integer, j As Integer, k As Integer
                Dim l As Integer, m As Integer, n As Integer
                Dim i1 As Integer, i2 As Integer, i3 As Integer
               Dim i4 As Integer, i5 As Integer, i6 As Integer
               On Error Resume Next
                For i = 65 To 66 : For j = 65 To 66 : For k = 65 To 66
             For l = 65 To 66 : For m = 65 To 66 : For i1 = 65 To 66
             For i2 = 65 To 66 : For i3 = 65 To 66 : For i4 = 65 To 66
             For i5 = 65 To 66 : For i6 = 65 To 66 : For n = 32 To 126
             ActiveSheet.Unprotect(Chr(i) & Chr(j) & Chr(k) & _
                Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n))
             If ActiveSheet.ProtectContents = False Then
                Exit Sub
             End If
                                Next : Next : Next : Next : Next : Next
                                 Next : Next : Next : Next : Next : Next
                end sub


----------------------

Private Sub UnprotectSheet()
        'Breaks worksheet password protection.

        Dim strPassword As String = Configuration.ConfigurationManager.AppSettings("ProtectPassword").ToString()
        Dim intCtr As Integer = 0
        Dim ObjExcel As New Excel.Application
        Dim objWbook As Excel.Workbook
        For intCtr = 0 To lstFiles.Items.Count - 1
            ObjExcel.Workbooks.Add(txtInputFolder.Text & "\" & lstFiles.Items(intCtr))
        Next
        Dim wsHeet As Excel.Worksheet

        ObjExcel.DisplayAlerts = False
        intCtr = 0
        For Each objWbook In ObjExcel.Workbooks
            Dim xlmodule As Object 'VBComponent
            xlmodule = objWbook.VBProject.VBComponents.Add(1) 'vbext_ct_StdModule

            Dim strCode As String
            strCode = _
               "sub MyMacro()" & vbCr & _
               "         Dim i As Integer, j As Integer, k As Integer " & vbNewLine & _
               " Dim l As Integer, m As Integer, n As Integer " & vbNewLine & _
                "Dim i1 As Integer, i2 As Integer, i3 As Integer " & vbNewLine & _
              " Dim i4 As Integer, i5 As Integer, i6 As Integer " & vbNewLine & _
              " On Error Resume Next " & vbNewLine & _
                "For i = 65 To 66 : For j = 65 To 66 : For k = 65 To 66 " & vbNewLine & _
            " For l = 65 To 66 : For m = 65 To 66 : For i1 = 65 To 66 " & vbNewLine & _
            " For i2 = 65 To 66 : For i3 = 65 To 66 : For i4 = 65 To 66 " & vbNewLine & _
            " For i5 = 65 To 66 : For i6 = 65 To 66 : For n = 32 To 126 " & vbNewLine & _
            " ActiveSheet.Unprotect(Chr(i) & Chr(j) & Chr(k) & _" & vbNewLine & _
            "    Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ " & vbNewLine & _
                " Chr(i4) & Chr(i5) & Chr(i6) & Chr(n))" & vbNewLine & _
            " If ActiveSheet.ProtectContents = False Then " & vbNewLine & _
            "    Exit Sub " & vbNewLine & _
            " End If " & vbNewLine & _
                          "      Next : Next : Next : Next : Next : Next " & vbNewLine & _
                                " Next : Next : Next : Next : Next : Next " & vbNewLine & _
                "end sub"


            strCode = _
               "sub MyMacro()" & vbCr & _
               " If ActiveSheet.ProtectContents = true Then" & vbNewLine & _
             "   ActiveSheet.Unprotect """ & strPassword & """ " & vbNewLine & _
            " End If " & vbNewLine & _
             "end sub"


            xlmodule.CodeModule.AddFromString(strCode)

            For Each wsHeet In objWbook.Worksheets
                wsHeet.Activate()
                If objWbook.ActiveSheet.ProtectContents = True Then
                    ObjExcel.Run("MyMacro")
                End If
            Next

            objWbook.Close(True, txtInputFolder.Text & "\" & lstFiles.Items(intCtr))
            intCtr = intCtr + 1


           
        Next
        ObjExcel.Quit()


    End Sub

No comments:

Post a Comment