我试图从MS Access打开一个文件夹中的每个XLSX文件，并编辑excel文档中的特定单元格。但是，其中一些文件受保护，有些则不受保护。因此，我尝试添加IF语句来检查此潜在障碍（我知道受保护的工作簿的密码，并且在所有工作簿中均保持一致）。
我尝试了下面的代码，但是每次更改其中一些代码后，它仍会返回各种错误（当前错误是“参数数量错误或属性无效”）
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
我只希望代码遍历文件夹中的每个excel文件并执行以下操作：
Edit1：修复了我在原始代码中看到的错字
答案 0 :(得分：0)
ws.Unprotect "550", True, True
这将是“错误的参数数量”。 Worksheet.Unprotect使用一个可选的Password参数-VBA不知道如何处理这两个True参数。
答案 1 :(得分：0)
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