troubleshooting Question

Unprotect Excel Worksbooks with Access VBA

Avatar of shieldsco
shieldscoFlag for United States of America asked on
Microsoft AccessMicrosoft Excel
6 Comments1 Solution129 ViewsLast Modified:
I' trying to modify the Excel Protection code below to Unprotect multiple workbooks in a folder.


Private Sub NavigationButton18_Click()
Dim xls As Object
Dim wb As Object
Dim wks As Object

Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim strBrowseMsg As String
Dim x As Integer

  On Error GoTo Err_Handler
 
strBrowseMsg = "Select the folder that contains the Data Call EXCEL files:"
strPath = BrowseFolder(strBrowseMsg)

If Nz(strPath, "") = "" Then
    MsgBox "No folder was selected.", vbOK, "No Selection"
    Exit Sub
End If

strFile = Dir(strPath & "\*.xls*")
Do While Len(strFile) > 0
    strPathFile = strPath & "\" & strFile
DoCmd.Hourglass True
    Set xls = CreateObject("Excel.Application")
    xls.Visible = False
    'xls.UserControl = True
    Set wb = xls.Workbooks.Open(strPathFile)
    For x = 1 To wb.Worksheets.Count
        'MsgBox x & " " & wb.Worksheets(x).Name
        If wb.Worksheets(x).Name = "Data Call" Then
            Set wks = wb.Worksheets(x)
        End If
    Next x
   
    'Cells Not To Lock
    With wks
        With .Range("A:A,H:H,I:I,J:J")
            If .Locked = True Then
                .Locked = False
            End If
        End With
        .Protect Password:="123"
    End With
    wb.Save
    wb.Close
    strFile = Dir()
Loop

DoCmd.Hourglass False
MsgBox "done!"
Exit Sub
Err_Handler:
   
   MsgBox Err.Description, vbExclamation, Err.Number


'xls.Quit

End Sub

Function BrowseFolder(Prompt As String) As String

Dim theFile As String
Dim response As Integer

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")

'first we have to select the desired drive
'Declare a variable as a FileDialog object.
Dim fd As Object

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(4)
'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

tryagain:
'Use a With...End With block to reference the FileDialog object.
With fd
    .InitialView = 2 'msoFileDialogViewDetails
    .Title = Prompt
    '.InitialFileName = theFile
    .ButtonName = "Use this folder"
    .AllowMultiSelect = False

    'The user pressed the action button.
    If .Show = True Then
        If .SelectedItems.Count = 0 Then
            MsgBox "You didn't make a valid selection.  Try again!"
            GoTo tryagain
        End If
       
        response = MsgBox("Use this Folder?", vbYesNo + vbCritical, "Last Chance")
        If response = vbYes Then
            'check that only one file was picked
            If .SelectedItems.Count > 1 Then
                MsgBox "You may only select one item.  Try again!"
                Exit Function
            Else
                vrtSelectedItem = .SelectedItems(1)
            End If
        Else
            Exit Function
        End If
    Else
        Exit Function
    End If

End With

BrowseFolder = CStr(vrtSelectedItem)
End Function
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 6 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 6 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros