Reputation: 15
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
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
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