VB6检查将被覆盖的文件是否打开

时间:2015-12-08 09:53:07

标签: vba excel-vba vb6 grid export-to-excel

如果未打开,此代码会覆盖现有文件,但如果文件未打开则不会覆盖现有文件,但如果文件未打开,我就不会进行任何验证,所以会发生的事情仍然是&#34 ;出口成功"即使它没有覆盖,因为文件目前是打开的。

 On Error GoTo errtrap

cd.CancelError = True
cd.Filter = "*.xls|*.xls"
cd.FileName = gReportTitle & " " & Format(Now, "mmddyyyy")
cd.ShowSave
If FileExists(cd.FileName) Then
        If fMessageBox("", "Overwrite File?", "Yes", "No", 0, 1, True) = 1 Then
            Grid1.ExportToExcel cd.FileName, True, True
            MsgBox ("Export Success!")
        Else
            Screen.MousePointer = vbDefault
            Exit Sub
        End If
    Else
         Grid1.ExportToExcel cd.FileName, True, True

End If
 Screen.MousePointer = vbDefault

   errtrap:
   Screen.MousePointer = vbDefault

1 个答案:

答案 0 :(得分:0)

以下代码将检查文件是否打开

Sub TestFileOpened()

Dim wb As Workbook

 Dim filename As String

 filename = "C:\Documents and Settings\vn\Desktop\test.xlsx"
    ' Test to see if the file is open.
    If IsFileOpen(filename) Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"

        Set wb = Workbooks.Open(filename)


'wb.Close

        '
        ' Add code here to handle case where file is open by another
        ' user.
        '
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        ' Open the file in Microsoft Excel.
 Set wb = Workbooks.Open(filename)

        '
        ' Add code here to handle case where file is NOT open by another
        ' user.
        '
    End If

End Sub

' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function