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

Question

我想执行，如果工作簿已经存在，那么如果不存在则重新运行它然后创建一个工作簿。

我有唯一值（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

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

有人可以帮帮我吗。

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"

但这不能说明文件是否无法删除（即已经打开）