【发布时间】：2022-07-04 03:05:08
【问题描述】：
我正在尝试：
检查指定文件夹以确保存在名称为 current year 的文件夹。如果没有，请创建它。
将已打开工作簿的 Sheet1 中的所有内容复制到新添加的工作簿中。
使用指定名称保存新工作簿并关闭它。
如果我有名称为当前年份的文件夹，则宏将按预期工作。
如果该文件夹不存在，则不会关闭该文件。它显示
运行时错误“对象_workbook的1004方法保存失败”。
Sub Copy_Data()
Dim ThisYear As String
Dim fdObj As Object
Dim wbO As Workbook
ThisYear = Format(Date, "YYYY")
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\Temp\" & ThisYear) Then GoTo DataCopy:
fdObj.CreateFolder ("C:\Temp\" & ThisYear)
DataCopy:
Sheet1.UsedRange.Copy
Set wbO = Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
wbO.SaveAs Filename:="C:\Temp\" & ThisYear & "\Data_New_" & Format(Now(), "ddmmyyyy"), FileFormat:=51 'Stops here
Windows("Data_New_" & Format(Now(), "ddmmyyyy") & ".xlsx").Close
End Sub
根据建议，我编辑了代码。我遇到了同样的问题。
如果我使用 F8 执行单步操作，则代码可以工作，但如果我运行宏，则会显示运行时错误。
Sub Copy_Data()
Dim ThisYear As String
Dim fdObj As Object
Dim wbO As Workbook
ThisYear = Format(Date, "YYYY")
Set fdObj = CreateObject("Scripting.FileSystemObject")
If Not fdObj.FolderExists("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear) Then
fdObj.CreateFolder ("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear)
End If
Sheet1.UsedRange.Copy
Set wbO = Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
wbO.SaveAs Filename:="C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear & "\Data_New_" & Format(Now(), "ddmmyyyy"), FileFormat:=51 'Stop here
wbO.Close
End Sub
【问题讨论】：
-
与您的问题无关，但像这样使用
GoTo通常不受欢迎。相反，请使用If Not fdObj.FolderExists("C:\Temp\" & ThisYear) Then、fdObj.CreateFolder "C:\Temp\" & ThisYear、End If。 -
使用
wb0.close而不是引用文件的窗口...此外：两次使用now()没有意义 - 它可能会有所不同！ -
您对
C:\Temp有写入权限？文件夹C:\Temp\2022存在吗？不存在具有该名称的文件（并且受写保护）？ -
@FunThomas，谢谢！事实上，我在尝试的宏代码中使用了不同的文件夹路径，由于文件夹路径显示公司名称，我只是选择在此处发布代码之前将其从文件夹路径中删除。没想到会引起混乱。道歉。我将更改代码并重新发布。
-
我不介意您使用的是哪个文件夹。您需要确保 (a) 文件夹存在 (b) 您对文件夹 (c) 具有写入权限，您可以确保文件名是唯一的，或者如果您已经有一个具有该名称的文件，则可以将其删除（请注意，如果文件已打开，则无法删除）。