如果工作簿存在或不使用 vba Excel 重新执行

Question

我要执行，如果工作簿已经存在则重新运行，如果不存在则创建一个工作簿。

我有唯一值（x）和数组（名称）。如果两者相等，我需要比较它们，否则必须创建一个工作簿，其名称为数组（名称），而唯一值（x）中没有（x）

我的代码：

Sub mac()

Dim c as integer
Dim x as range
Dim s_AgingSCM as string
Dim Array_SCM_Aging as variant
Dim NewBook as workbook
Dim NewBook_SCM as workbook
Dim Master_workbook as workbook
Dim rngCopy_Aging as range
Dim rngFilter_Ws2 as range

For c = LBound(Array_SCM_Aging) To UBound(Array_SCM_Aging)
            Set Master_workbook = ThisWorkbook
            s_AgingSCM = Array_SCM_Aging(c, 1)
            Set x = Master_workbook.Sheets("BASS").Range("AY" & c)
                    If x = s_AgingSCM Then                                                      

                         With rngFilter_Ws2

                                .AutoFilter field:=32, Criteria1:="<>(a)  0 - 360", Operator:=xlFilterValues
                                .AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues

                         Set rngCopy_Aging = .SpecialCells(xlCellTypeVisible)
                                             .AutoFilter ' Switch off AutoFilter
                         End With

                         rngCopy_Aging.Copy NewBook.Worksheets("Aging Inventory").Cells(1, 1)
                         Application.DisplayAlerts = False           
                   Else

                   Dim fso: Set fso = createObject("Scripting.FileSystemObject")
                    Dim folder: Set folder = fso.GetFolder("C:\")
                    Dim file, fileNames                    
                    Dim rngCopy_SCMAging As Range                   

                    For Each file In folder.Files
                            If Right(file.Name, 4) = "xlsx" Then
                            fileNames = fileNames & file.Name & ";"         ' will give a list of all filenames
                            End If
                    Next

                    If InStr(fileNames, s_AgingSCM) = 0 Then                     

                            With NewBook_SCM                            

                                Set NewBook_SCM = Workbooks.Add
                            .Title = s_AgingSCM
                          NewBook_SCM.Worksheets("sheet1").Name = "Aging Inventory"
                            With rngFilter_Ws2

                                .AutoFilter field:=32, Criteria1:="<>(a)  0 - 360", Operator:=xlFilterValues
                                .AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues

                                Set rngCopy_SCMAging = .SpecialCells(xlCellTypeVisible)
                                                       .AutoFilter ' Switch off AutoFilter
                            End With

                                rngCopy_SCMAging.Copy Destination:=NewBook_SCM.Worksheets("Aging Inventory").Cells(1, 1)                            

                          .SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"
                          Application.DisplayAlerts = False
                          NewBook_SCM.Close                           
                        End With
'                      Else
                    End If

End sub

我被困在这里两天了。我想要的是如果工作簿存在然后用新工作簿覆盖，否则如果它不存在则创建一个新工作簿。

谁能帮帮我。

Answer 1

一个快速的方法是放置：-

If fso.FileExists(Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx")
    fso.DeleteFile Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx", True
End If

上线

.SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"

但是如果文件不能被删除（即已经打开），这不会考虑