Question

我的VBA应用程序从.csv文件（作为原始文件）更新一些.xls文件（作为数据库文件）。
要更新这些.xls文件应用程序，请在查找文件（.xls文件）中查找一些信息，并在数据库中查找更新。如果我从不同的文件夹运行相同的应用程序来更新不同的数据库文件，但使用相同的查找文件，应用程序工作正常，但最后它无法关闭所有查找文件和原始文件。并且应用程序也没有抛出任何异常。我在READ ONLY模式下打开这些查找文件。如何关闭这些文件而不保存它们？请就此问题提出建议

实际上我正在从Windows调度程序运行该工具，因此它会在进程完成时自动关闭所有内容。但我所看到的是该工具没有关闭这些文件： - 3个查找文件，工具从中提取（读取）一些信息以更新数据库文件。 - 最后打开的原始文件。 - 上次打开的数据库文件

要打开查找文件和原始文件，我使用下面的代码设置Wbk_MachinLookUp_SN = Workbooks.Open（FileNameandExt ,, ReadOnly：= True）

打开数据库文件：设置wbk_dtc_Month = Workbooks.Open（FilenameWith_Path）

我正在关闭查找和原始文件而不保存它们，代码是：

Public Sub CloseAllFiles()
 Dim StrName As String
 Application.ScreenUpdating = False
 On Error Resume Next

    StrName = ToCheckExtention(Form_TopLevel.TextBox_SubSystem_LookUp, 1)
    If Module2.IsXLBookOpen(StrName) = True Then
        Application.DisplayAlerts = False
        Wbk_SubSystem.Close Savechanges:=False
        Application.DisplayAlerts = False
        Set Wbk_SubSystem = Nothing
    End If

    StrName = ToCheckExtention(Form_TopLevel.TextBox_MachineSN_LookUp, 1)
    If Module2.IsXLBookOpen(StrName) = True Then
        Wbk_MachinLookUp_SN.Close Savechanges:=False
        Set Wbk_MachinLookUp_SN = Nothing
    End If

    StrName = ToCheckExtention(Form_TopLevel.TextBox_SwPn_Rel_LookUp, 1)
    If Module2.IsXLBookOpen(StrName) = True Then
        Application.DisplayAlerts = False
        Wbk_SW_ReleseasesLookup.Close Savechanges:=False
        Application.DisplayAlerts = False
        Set Wbk_SW_ReleseasesLookup = Nothing
    End If

    StrName = ToCheckExtention(Form_TopLevel.TextBox_SwPn_ESI_BR, 1)
    If Module2.IsXLBookOpen(StrName) = True Then
        Application.DisplayAlerts = False
        Module2.Wbk_sw_pn.Close Savechanges:=False
        Application.DisplayAlerts = False
        Set Wbk_sw_pn = Nothing
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Function ToCheckExtention(Str As String, Flag As Byte) As String

Dim IndexNo As Integer
Dim temp As String
Application.ScreenUpdating = False
IndexNo = InStr(Str, "\")
If IndexNo <> 0 Then
    temp = StrReverse(Str)
    IndexNo = InStr(temp, "\")
    Str = VBA.MID(temp, 1, IndexNo - 1)
    Str = StrReverse(Str)
End If

    IndexNo = InStr(Str, ".")
    If IndexNo <> 0 Then
        temp = VBA.MID(Str, IndexNo + 1, Len(Str))
        If temp = "xls" Or temp = "csv" Then
            ToCheckExtention = Str
            Exit Function
        End If
    ElseIf IndexNo = 0 Then
        If Flag = 1 Then
            Str = Str & ".xls"
            ToCheckExtention = Str
            Exit Function
        ElseIf Flag = 0 Then
            Str = Str & ".csv"
            ToCheckExtention = Str
            Exit Function
        End If
    End If
ToCheckExtention = Str
Application.ScreenUpdating = False
End Function


Function IsXLBookOpen(StrName As String) As Boolean
Dim i As Long, XLAppFx As Excel.Application, NotOpen As Boolean
Dim IndexNo As Integer
Dim temp As String
Application.ScreenUpdating = False
 'Find/create an Excel instance

IndexNo = InStr(StrName, "\")
If IndexNo <> 0 Then
    temp = StrReverse(StrName)
    IndexNo = InStr(temp, "\")
    StrName = VBA.MID(temp, 1, IndexNo - 1)
    StrName = StrReverse(StrName)
End If

On Error Resume Next
Set XLAppFx = GetObject(, "Excel.Application")
If Err.Number = 429 Then
    NotOpen = True
    Set XLAppFx = CreateObject("Excel.Application")
    Err.Clear
End If

 'Loop through all open workbooks in such instance
For i = XLAppFx.Workbooks.Count To 1 Step -1
    If XLAppFx.Workbooks(i).Name = StrName Then Exit For
Next i

 'Set all to False
IsXLBookOpen = False

 'Perform check to see if name was found
If i <> 0 Then IsXLBookOpen = True

 'Close if was closed
If NotOpen Then XLAppFx.Quit

 'Release the instance
Set XLAppFx = Nothing
Application.ScreenUpdating = False
End Function

要关闭数据库文件（我保存所有数据库文件），这里是代码：

With wbk_dtc_Month
If Version > 11 Then
   .SaveAs FileName:=BuildFolderAndFileName, FileFormat:=56
Else
   .SaveAs FileName:=BuildFolderAndFileName
End If
Application.DisplayAlerts = False
   .Close
Application.DisplayAlerts = True
End With
Set wbk_dtc_Month = Nothing

Answer 1

我已经解决了不关闭所有文件的问题。我已经在函数“Function IsXLBookOpen”中进行了修改

改变是：

Function IsXLBookOpen(StrName As String) As Boolean

Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(StrName)
On Error GoTo 0
If oBk Is Nothing Then
    IsXLBookOpen = False
Else
    IsXLBookOpen = True
End If

End Function

如果我以只读模式打开文件，早期的函数没有返回正确的值。

如果两个应用程序一次使用相同的工作簿，则工具无法关闭这些工作簿（vba）

1 个答案: