excel - VBA：我需要保存文件，但如果重复，请在文件名末尾执行序列“_1，_2，_3，...”

Question

我的代码复制打开的工作簿，然后用分析月份重命名复制的工作簿，但我需要保存该月份的所有分析，并在文件名末尾执行序列。我尝试了一些简单的循环，但它不起作用。

            Sub NewReport()
            Dim Wb1 As Workbook
            Dim Wb2 As Workbook
            Dim dateStr As String
            Dim myDate As Date
            Dim i As Integer

            With Application
                .ScreenUpdating = False
                .DisplayAlerts = False
                .EnableEvents = False
            End With

            Set Wb1 = ActiveWorkbook

            myDate = Date

            dateStr = Format(myDate, "mmm_yyyy")

            Set Wb2 = Application.Workbooks.Add(1)
            Wb1.Sheets(Array(Wb1.Sheets(1).Name)).Copy Before:=Wb2.Sheets(1)
            Wb2.Sheets(Wb2.Sheets.Count).Delete
            On Error GoTo Fim
            'Wb2.SaveAs Filename:="\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\" & "Phase_IN_Phase_OUT" & "_" & dateStr, FileFormat:=51

            'Wb2.Close
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
            End With
        Fim:

        Wb2.SaveAs Filename:="\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\" & "Phase_IN_Phase_OUT" & "_" & dateStr & "_", FileFormat:=51

        End Sub

更新

我试着放一个“i + 1”，宏运行到版本 2！但是在第三次我有同样的错误，因为“i”被重置了。假设这个人没有运行宏 50 次，我可以在最后做 50 次哈哈。有什么建议么？

            Sub NewReport()
            Dim Wb1 As Workbook
            Dim Wb2 As Workbook
            Dim dateStr As String
            Dim myDate As Date

            i = 1

            With Application
                .ScreenUpdating = False
                .DisplayAlerts = False
                .EnableEvents = False
            End With

            Set Wb1 = ActiveWorkbook

            myDate = Date

            dateStr = Format(myDate, "mmm_yyyy")

            Set Wb2 = Application.Workbooks.Add(1)
            Wb1.Sheets(Array(Wb1.Sheets(1).Name)).Copy Before:=Wb2.Sheets(1)
            Wb2.Sheets(Wb2.Sheets.Count).Delete
            On Error GoTo Fim
            Wb2.SaveAs Filename:="\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\" & "Phase_IN_Phase_OUT" & "_" & dateStr & "_" & i, FileFormat:=51

            'Wb2.Close
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
            End With

            Fim:
            i = i + 1
            Wb2.SaveAs Filename:="\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\" & "Phase_IN_Phase_OUT" & "_" & dateStr & "_" & i, FileFormat:=51

        End Sub

标签： excelvbasequencefilenames

Answer 1

所以，问题是如何从类似的东西中获得：

\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\Phase_IN_Phase_OUT_probablySomeString_21

最后增加一个值，如下所示：

\\BRGABS001\g_supc\P.C.P\07- Comum\Natalia\3_TESTE_MACRO\Phase_IN_Phase_OUT_probablySomeString_22

这可以通过以下步骤进行：

• 取出字符串并将其拆分为_.
• 将字符串的最后一部分增加 1。

---

Public Sub TestMe()

    Dim fileName As String
    Dim dateStr As String: dateStr = "probablySomeString"
    Dim i As Long: i = 21

    fileName = "\\BRGABS001\g_supc\P.C.P\07- Comum\" & _
            "Natalia\3_TESTE_MACRO\Phase_IN_Phase_OUT" & "_" & dateStr & "_" & i

    Debug.Print fileName
    Debug.Print Increment(fileName)

End Sub

Public Function Increment(fileName As String) As String

    Dim myResult As String
    Dim newValue As Long
    Dim myArr As Variant

    newValue = Split(fileName, "_")(UBound(Split(fileName, "_"))) + 1
    myArr = Split(fileName, "_")
    myArr(UBound(Split(fileName, "_"))) = newValue
    Increment = Join(myArr, "_")

End Function

---

如果初始文件如下所示：

~omum\Natalia\3_TESTE_MACRO\Phase_IN_Phase_OUT_probablySomeString_21.xlsx然后以下示例有效：

Public Sub TestMe()

    Dim fileName As String
    Dim dateStr As String: dateStr = "probablySomeString"
    Dim i As Long: i = 21

    fileName = "\\BRGABS001\g_supc\P.C.P\07- Comum\" & _
            "Natalia\3_TESTE_MACRO\Phase_IN_Phase_OUT" & "_" & dateStr & "_" & i & ".xlsx"

    Debug.Print fileName
    Debug.Print Increment(fileName)

End Sub

Public Function Increment(fileName As String) As String

    Dim myResult As String
    Dim newValue As Long
    Dim myArr As Variant

    newValue = Split(Split(fileName, "_")(UBound(Split(fileName, "_"))), ".")(0) + 1
    myArr = Split(fileName, "_")
    myArr(UBound(Split(fileName, "_"))) = newValue
    Increment = Join(myArr, "_")
    Increment = Increment & ".xslx"

End Function