Question

我正在尝试保存文件，但是在此之前，我要检查同一文件夹中是否已存在相同名称的文件，如果存在，则我将旧的现有文件重命名（在其名称上添加时间戳）并将其移至不同的文件夹位置。为了重命名，我使用“名称”方法，但显示错误。

我已经测试了同名文件已经存在。要添加的时间戳也即将出现。下面是代码。

Dim Test As String

  On Error Resume Next
    Test = Dir(ThisWorkbook.Sheets("Sheet1").Range("B5").Text)
  On Error GoTo 0

  If Test = "" Then
    fileexist = False

  Else
    fileexist = True
    Timestamp = CStr(FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B5").Text))

    Newname = Left((ThisWorkbook.Sheets("Sheet1").Range("B5").Text), Len((ThisWorkbook.Sheets("Sheet1").Range("B5").Text)) - 5) & Timestamp & ".xlsx"

    Name (ThisWorkbook.Sheets("Sheet1").Range("B5").Text) As Newname
'*** Just this last above statment is giving error
End if

该文件已经存在，为什么Name方法给出错误信息？预先感谢您的帮助。

Answer 1

也许可以尝试一下：

Sub tryme()


Dim test As String

  On Error Resume Next
    test = Dir(ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("B5").Text)
  On Error GoTo 0

  If test = "" Then
    fileexist = False

  Else
    fileexist = True
    Timestamp = CStr(FileDateTime(ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("B5").Text))

    newname = Left((ThisWorkbook.Sheets("Sheet1").Range("B5").Text), Len((ThisWorkbook.Sheets("Sheet1").Range("B5").Text)) - 5) & Format(Timestamp, "ddmmmyyyy") & ".xlsm"

     ThisWorkbook.SaveAs FileName:=ThisWorkbook.Path & "\" & newname

End If



End Sub

如果路径位于B5 中，请按照以下步骤操作：

Dim Test As String

  On Error Resume Next
    Test = Dir(ThisWorkbook.Sheets("Sheet1").Range("B5").Text)
  On Error GoTo 0

  If Test = "" Then
    fileexist = False

  Else
    fileexist = True
    Timestamp = CStr(FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B5").Text))

    Newname = Left((ThisWorkbook.Sheets("Sheet1").Range("B5").Text), Len((ThisWorkbook.Sheets("Sheet1").Range("B5").Text)) - 5) & Format(Timestamp, "ddmmmyyyy") & ".xlsx"

    'Name (ThisWorkbook.Sheets("Sheet1").Range("B5").Text) As Newname
     ThisWorkbook.SaveAs FileName:=ThisWorkbook.Path & "\" & Newname 

End if

重命名现有的已关闭文件，但“名称”方法显示错误

1 个答案: