如果未打开,此代码会覆盖现有文件,但如果文件未打开则不会覆盖现有文件,但如果文件未打开,我就不会进行任何验证,所以会发生的事情仍然是&#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
答案 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