Question

我需要根据指定文件夹中是否已存在类似命名的文件来保存文件的增量编号版本的代码。

例如，

检查当前打开的文件的确定性，比如命名＆＃34; Inv_Dec_2015.xlsx＆＃34;在名为＆＃34; Reports＆＃34;的文件夹中。
如果文件存在，请检查＆＃34; Inv_Dec_2015_v1.xlsx＆＃34;在＆＃34;报告＆＃34;。
如果文件存在，请检查＆＃34; Inv_Dec_2015_v2.xlsx＆＃34;在＆＃34;报告＆＃34;。
如果文件存在，请检查＆＃34; Inv_Dec_2015_v3.xlsx＆＃34;在＆＃34;报告＆＃34;。
如果文件不存在，请将当前打开的文件另存为＆＃34; Inv_Dec_2015_v3.xlsx＆＃34;

等等，直到任意数量的版本......

我在Ron de Bruin的网站上发现了以下两段代码，这些代码可用于此类内容，并根据我的目的对其进行了一些修改，但我不知道如何使用它来检查对于预先存在的文件。

非常感谢任何帮助。

Sub Rename_Store_Wbk()
    Dim sPath As String

' Enter the path at which file is to be stored

    sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"

' Check whether the file already exists by calling the FileExist function

    If FileExist(sPath) = False Then
    ActiveWorkbook.SaveAs Filename:=sPath, _
         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If

End Sub


Function FileExist(FilePath As String) As Boolean

Dim TestStr As String

'Test File Path (ie "C:\Users\Chris\Reports\Inv_Dec_2015.xlsm")
  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If

End Function

Answer 1

看看我在这里添加的循环是否适合您：

Sub Rename_Store_Wbk()

    Dim sPath As String

    ' Enter the path at which file is to be stored
    sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"

    If Not FileExists(sPath) Then

        i = 1
        Do

            sPath = Left(sPath, Len(sPath) - 5) & "_v" & i & ".xlsx"
            i = i + 1

        Loop Until FileExists(sPath)

    End If

    ActiveWorkbook.SaveAs Filename:=sPath, _
         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

根据文件夹内容保存excel文件的编号版本

1 个答案: