VBA将文件保存在桌面上，如果名称已被占用，请为其添加一个数字

Question

下面的一段代码在桌面上保存了一个"Test"文件。 但是，如果再次运行宏，则会覆盖该文件。 如果测试名称已被采用，如何修改代码以便将文件另存为 Test2 等？ *"测试"名称每个月都不同。

Dim Path As String
Monthh = MonthName(Month(Date))
TargetName = "Test"
TargetBook.Windows(1).Caption = TargetName

Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & ""
ActiveWorkbook.SaveAs Path & TargetName & ".xlsx"
ActiveWorkbook.Close
MsgBox TargetName & " has been saved on your desktop."

Answer 1

循环和检查文件是否存在的组合允许您保存任意次数：

Private Sub Test()
TargetName = GetTargetName(Path & TargetName & ".xlsx")
ActiveWorkbook.SaveAs TargetName
MsgBox TargetName & " has been saved on your desktop."
End Sub
Private Function GetTargetName(ByVal TargetName As String) As String
Dim i As Integer
Dim fso As FileSystemObject
i = 1
GetTargetName = TargetName
Set fso = New FileSystemObject
Do While fso.FileExists(GetTargetName)
i = i + 1
GetTargetName = fso.GetBaseName(TargetName) & i & "." & fso.GetExtensionName(TargetName)
Loop
End Function

Answer 2

我使用了这样的东西：

Dim TargetName As String, FileBaseName As String
Dim i As Integer
TargetName = "Test"
TargetBook.Windows(1).Caption = TargetName
' change your variable - can't use Path as a variable
TargetPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & ""
' if a file with same name already exists in the folder
' add a # to it until we have a unique name
i = 1
FileBaseName = TargetName
Do Until Dir$(TargetPath & TargetName & ".xlsx") = ""
TargetName = FileBaseName & i
i = i + 1
Loop
ActiveWorkbook.SaveAs TargetPath & TargetName & ".xlsx"

Answer 3

要检查文件是否存在，请使用Dir函数：

If Len(Dir(Path & TargetName)) > 0 Then '   file already currently exists
'    need to get a new unique file name
End If

问候

Answer 4

也许你可以这样做：

If Dir(Path & TargetName) <> "" Then 'Check if file exist
TargetName = val(TargetName)+1 & Mid(TargetName,Len(CVar(TargetName))+1)
Else

要完成这项工作，您必须在 TargetName 的前端获取数字，例如：1file

这段代码做什么：

val(TargetName)在此处返回文件名中的数字1

val(TargetName)+1加 1 所以 1 + 1 =2

Mid(TargetName,Len(CVar(TargetName))+1)删除字符串的编号，使其返回：文件

val(TargetName)+1 & Mid(TargetName,Len(CVar(TargetName))+1)会给你2个文件