Greg Williams
Greg Williams

Reputation: 15

Trying to go through all XLSX files within a folder, unprotect them, change value, and protect them

From MS Access, I am attempting to open every XLSX file within a folder and edit a specific cell within the excel document. However some of these files are protected and some are not. Therefore I am trying to add an IF statement to check for this potential roadblock (I know the password for the protected workbooks and it is consistent across all of them).

I have tried the below code but it keeps returning various errors after every time I alter some of it to work (current error is "Wrong Number of arguments or invalid property):

Private Sub Command0_Click()

    Dim xl          As Excel.Application
    Dim wb          As Excel.Workbook
    Dim ws          As Excel.Worksheet
    Dim fso         As FileSystemObject
    Dim objFolder   As Folder
    Dim objFile     As File
    Dim strPath     As String
    Dim strFile     As String
    Dim errnum      As Long
    Dim errtxt      As String

    'Specify the path to the folder.
    strPath = CurrentProject.Path & "\originals"

    '***** Set a reference to "Microsoft Scripting Runtime" by using
    '***** Tools > References in the Visual Basic Editor (Alt+F11)

    'Create an instance of the FileSystemObject.
    Set fso = New Scripting.FileSystemObject

    'Alternatively, without the reference mentioned above:
    'Set fso = CreateObject("Scripting.FileSystemObject")

    'Get the folder.
    Set objFolder = fso.GetFolder(strPath)

    'If the folder does not contain files, exit the sub.
    If objFolder.Files.Count = 0 Then
        MsgBox "No files found in the specified folder.", vbApplicationModal + _
        vbExclamation + vbOKOnly, "Runtime Error"
        Exit Sub
    End If

    'Turn off screen updating. It may run quicker if updating is disabled, but
    'if the work to be done is minimal, it may not be necessary.
    Set xl = Excel.Application
    xl.ScreenUpdating = False
    DoCmd.SetWarnings False

    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        strFile = objFile.Path

        'Open each file and perform actions on it.
        Set wb = xl.Workbooks.Open(objFile.Path)

        'Set inline error trap in case PLOG tab does not exist.
        On Error Resume Next
        Set ws = wb.Worksheets("Whole Foods Market PLOG")
        wb.Application.DisplayAlerts = False
        errnum = Err.Number
        errtxt = Err.Description
        On Error GoTo -1

        Select Case errnum
            Case 0 'Zero = no error.
                If ws.ProtectContents = True Then
                        ws.Unprotect "550" 'enter password
                End If
                ws.Cells(11, 20).Value = Date
                ws.Protect "550", True, True
                wb.Save
            Case 9 'Subscript out of range; most likely the tab does not exist.
                MsgBox "The workbook '" & objFile.Name & "' does not have a 'PLOG' tab."
            Case 58
                MsgBox "Fix This"
            Case 91
                Resume Next
            Case Else 'All other errors.
                MsgBox "Runtime error #" & CStr(errnum) & ": " & IIf(Right(errtxt, 1) = ".", errtxt, errtxt & ".")
        End Select

        wb.Application.DisplayAlerts = True
        wb.Close False
        Set wb = Nothing

    Next objFile

    'Turn screen updating back on
    xl.ScreenUpdating = True

    'IMPORTANT: Clean up & quit Excel. If this is not done, Excel will stay in memory
    'after the macro ends. If this is done repeatedly, many individual instances of Excel
    'will build up in memory, and will stay there until killed with an task app such as
    'Windows Task Manager or SysInternals ProcessExplorer, or until the system is rebooted,
    'and it may even prevent Windows from shutting down properly because all those instances
    'of Excel are waiting for user input at the "Save workbook? Yes/No/Cancel" dialog.
    xl.Quit
    Set xl = Nothing

End Sub

I simply want the code to go through each excel file within the folder and do this:

Edit1: fixed a typo I saw in the original code

Upvotes: 0

Views: 418

Answers (2)

spinjector
spinjector

Reputation: 3525

Option Compare Database
Option Explicit

Public Sub SO56995486()

    'Declare the variables
    Dim xl          As Excel.Application
    Dim wb          As Excel.Workbook
    Dim ws          As Excel.Worksheet
    Dim fso         As Scripting.FileSystemObject
    Dim objFolder   As Scripting.Folder
    Dim objFile     As Scripting.file
    Dim fileList    As VBA.Collection
    Dim fldrPath    As String
    Dim fullpath    As String
    Dim filename    As String
    Dim errnum      As Long
    Dim c           As Long
    Dim i           As Long

    'Specify the path to the folder.
    fldrPath = "C:\Temp\"

    'Set up a log file.
    Open fldrPath & "_logfile.txt" For Output As #1

    '***** Set a reference to "Microsoft Scripting Runtime" by using
    '***** Tools > References in the Visual Basic Editor (Alt+F11)

    'Set up the major object variables.
    Set xl = Excel.Application
    Set fso = New Scripting.FileSystemObject
    Set fileList = New VBA.Collection

    'Get the folder.
    Set objFolder = fso.GetFolder(fldrPath)

    'If the folder does not contain files, exit the sub.
    If objFolder.Files.Count = 0 Then
        MsgBox "No files found in the specified folder.", vbApplicationModal + _
        vbExclamation + vbOKOnly, "Runtime Error"
        Exit Sub
    End If

    'Create a list of all XLSX files in the folder.
    For Each objFile In objFolder.Files
        filename = objFile.Name
        If UCase(fso.GetExtensionName(filename)) = "XLSX" Then
            fileList.Add objFile
        End If
    Next

    'Remove any Excel temp files. Tricky loop since items may be deleted.
    i = 1
    Do
        Set objFile = fileList.ITEM(i)
        filename = Left(objFile.Name, 2)
        If filename = "~$" Then
            fileList.Remove (i)
        Else
            i = i + 1
        End If
    Loop Until i >= fileList.Count

    'Remove any open files. Tricky loop again.
    i = 1
    Do
        Set objFile = fileList.ITEM(i)
        fullpath = objFile.Path
        If IsFileOpen(fullpath) Then
            fileList.Remove (i)
        Else
            i = i + 1
        End If
    Loop Until i >= fileList.Count

    'Turn off screen updating. It may run quicker if updating is disabled, but
    'if the work to be done is minimal, it may not be necessary.
    xl.ScreenUpdating = False
    DoCmd.SetWarnings False

    'Loop through each file in the folder
    For Each objFile In fileList
        fullpath = objFile.Path
        'Open the file. Use inline error trap in case it can't be opened.
        On Error Resume Next
        Set wb = xl.Workbooks.Open(fullpath)
        errnum = Err.Number
        On Error GoTo 0
        Select Case errnum
            Case 0 'File opened ok.
                'Use inline error trap in case PLOG tab does not exist.
                On Error Resume Next
                Set ws = wb.Worksheets("PLOG")
                errnum = Err.Number
                On Error GoTo 0
                Select Case errnum
                    Case 0 'Tab reference grabbed ok.
                        If ws.ProtectContents = True Then
                                ws.Unprotect "550" 'enter password
                        End If
                        ws.Cells(11, 20).value = Date
                        ws.Protect "550", True, True
                        On Error Resume Next
                        wb.Save
                        errnum = Err.Number
                        On Error GoTo 0
                        Select Case errnum
                            Case 0 'Saved ok.
                                Print #1, "OK: " & objFile.Name
                            Case Else
                                Print #1, "Couldn't save: " & objFile.Name
                        End Select
                    Case 9 'Subscript out of range; probably tab does not exist.
                        Print #1, "Tab does not exist: " & objFile.Name
                    Case Else 'Other errors.
                        Print #1, "Other error (" & CStr(errnum) & "): " & objFile.Name
                End Select
            Case Else
                Print #1, "Can't open file: "; Tab(20); objFile.Name
        End Select
        wb.Close True
        Set wb = Nothing
    Next

    'Turn screen updating back on
    xl.ScreenUpdating = True
    DoCmd.SetWarnings True


    'IMPORTANT: Clean up & quit Excel. If this is not done, Excel will stay in memory
    'after the macro ends. If this is done repeatedly, many individual instances of Excel
    'will build up in memory, and will stay there until killed with an task app such as
    'Windows Task Manager or SysInternals ProcessExplorer, or until the system is rebooted,
    'and it may even prevent Windows from shutting down properly because all those instances
    'of Excel are waiting for user input at the "Save workbook? Yes/No/Cancel" dialog.
    xl.Quit
    Set xl = Nothing
    Close #1

End Sub

Public Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next
    filenum = FreeFile()
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0

    Select Case errnum
        Case 0
            'No error.
            IsFileOpen = False
        Case 55, 70
            'File already open.
            IsFileOpen = True
        Case Else
            'Other error.
            'IsFileOpen = ?
    End Select

End Function

Upvotes: 0

Mathieu Guindon
Mathieu Guindon

Reputation: 71217

ws.Unprotect "550", True, True

This would be the "wrong number of arguments". Worksheet.Unprotect takes a single, optional, Password parameter - VBA doesn't know what to do with these two True arguments.

Upvotes: 0

Related Questions