Question

下面的代码通过一个文件夹并根据作者姓名重命名文件，但是我无法完全执行它，因为我收到一个错误消息，说文件是只读的。

如何调整代码以读写方式打开文件，以便可以使用新名称保存文件？没有我，手动将文件重新保存为吗？还是我首先需要一个单独的宏？

Sub RenameExcelFilesbyAuthor()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim Counter As Integer

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "C:\Users\Name\Documents\Excel Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
'NextCode:
 myPath = myPath
 If myPath = "" Then GoTo ResetSettings

 'Target File Extension (must include wildcard "*")
 myExtension = "*.xlxs*"

 'Target Path with Ending Extention
 myFile = Dir(myPath & myExtension)

 Counter = 1

 'Loop through each Excel file in folder
 Do While myFile <> ""
  ReadOnly = False
    Set wb = Nothing
    On Error Resume Next
    'Set variable equal to opened workbook
     Set wb = Workbooks.Open(Filename:=myPath & myFile)
    On Error GoTo 0
    If wb Is Nothing Then
        wb.Close
    Else
    Counter = Counter + 1
    'Ensure Workbook has opened before moving on to next line of code
     DoEvents

   'Change First Worksheet's Background Fill Blue
     wb.Name = ThisWorkbook.BuiltinDocumentProperties("Last Author") & Counter

   'Save and Close Workbook
     wb.Close SaveChanges:=True

   'Ensure Workbook has closed before moving on to next line of code
     DoEvents
    End If

   'Get next file name
     myFile = Dir

 Loop

 'Message Box when tasks are completed
 MsgBox "Task Complete!"

 'ResetSettings:
 'Reset Macro Optimization Settings
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True

End Sub

'''

如何打开Excel文件作为读写VBA循环

0 个答案: