"Check if file is open" quandry.

[LEXCERM]

Dim objExcel As Excel.Application
Set objExcel = New Excel.Application
Dim strFileName As String
strFileName = objExcel.Application.GetOpenFileName("Select CSV file, *.csv", , "CSV file")

If "FILE IS ALREADY OPEN" Then
MsgBox "File is currently open.  Please close and re-run this program.", vbInformation, "Program Error"
GoTo end_:
Else
Set objworkbook = objExcel.Workbooks.Open(strFileName, , False)
objExcel.Columns("A:B").Insert Shift:=xlToRight
objExcel.Range("A5").FormulaR1C1 = "Account No"
objExcel.Range("B5").FormulaR1C1 = "Invoice No"
objExcel.Range("A6:A" & Range("C65536").End(xlUp).Row).FormulaR1C1 = Range("D1").Value
objExcel.Range("B6:B" & Range("C65536").End(xlUp).Row).FormulaR1C1 = Range("F1").Value
objExcel.Rows("1:4").Delete Shift:=xlUp

objExcel.Application.ActiveWorkbook.Close True
MsgBox "CSV file formatted.", vbInformation
End If

end_:
Set objExcel = Nothing
Set objworkbook = Nothing

Hi there,

I use the above code to open any CSV file, format it as required, then close/save it.

What I need to do is to find out if the file I have selected is already open and, if so, not to proceed with the code (see If "FILE NOT OPEN" line above).

I have tried several statements but am having no luck.

Thanks in advance,
Paul.

 

[ghudson]

You should get a runtime error number for which you can then trap for and take [or not take] action if it is open. You are using an error handler in your code?

 

[LEXCERM]

Hi GHUDSON and thanks for replying.

Before the run-time error appears (3051) a "save as" dialog box opens and pressing cancel produces the error you have mentioned. The line which is causing the "save as" is:-

objExcel.Application.ActiveWorkbook.Close True

The full code is as follows:-

Dim objExcel As Excel.Application
Set objExcel = New Excel.Application
Dim strFileName As String
strFileName = objExcel.Application.GetOpenFileName("Select CSV file, *.csv", , "CSV file")

Select Case strFileName
    Case False
    GoTo end_
    Case Else
    GoTo CONT
End Select

CONT:

Set objworkbook = objExcel.Workbooks.Open(strFileName, , False)
objExcel.Columns("A:B").Insert Shift:=xlToRight
objExcel.Range("A5").FormulaR1C1 = "Account No"
objExcel.Range("B5").FormulaR1C1 = "Invoice No"
objExcel.Range("A6:A" & Range("C65536").End(xlUp).Row).FormulaR1C1 = Range("D1").Value
objExcel.Range("B6:B" & Range("C65536").End(xlUp).Row).FormulaR1C1 = Range("F1").Value
objExcel.Rows("1:4").Delete Shift:=xlUp
objExcel.Range("AE1").FormulaR1C1 = "Second Ref"
objExcel.Range("AF1").FormulaR1C1 = "Third Ref"

objExcel.Application.ActiveWorkbook.Close True

DoCmd.TransferText acImportDelim, , "tbl_invoice_dat", strFileName, True
MsgBox "CSV file..." & vbNewLine & vbNewLine & strFileName & vbNewLine & vbNewLine & "...has been imported.", vbInformation, "Import Complete"

end_:
Set objExcel = Nothing
Set objworkbook = Nothing

How can I avoid the "save as" dialog box from appearing if the file is already open?

And yes, I will be including error handlers at some point.

Thanks again.

Paul.

 

[The_Doc_Man]

You can sweep through the collection of open workbooks exposed by the Excel Application object and check for their names.

Syntax for this is something like Workbooks.Name and run the loop on n, from 1 to Workbooks.Count

If it is still open, you'll find its name.

 

[LEXCERM]

Thanks The Doc Man!

From your idea I managed to sort it out.

Kind rgds,
Paul.

 

[ghudson]

Out of curiosity could you post the code you used? Thanks!

 

[LEXCERM]

Hi there GHUDSON,

 [COLOR=Blue]Option Compare Database [/COLOR] 
---------------------------------------------------------------
[COLOR=Red]'||| Make sure that the following REFERENCES are set:....
'||| MICROSOFT OFFICE 10.0 OBJECT LIBRARY
'||| MICROSOFT EXCEL 10.0 OBJECT LIBRARY[/COLOR]
---------------------------------------------------------------
[COLOR=Red]'Function to check if selected CSV file is already open[/COLOR]
Function IsFileOpen(strFullPathFileName As String) As Boolean
Dim hdlFile As Long
	On Error GoTo FileIsOpen:
	hdlFile = FreeFile
	Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
	IsFileOpen = False
	Close hdlFile
	Exit Function
FileIsOpen:
	IsFileOpen = True
	Close hdlFile
End Function
-------------------------------------------------------
Private Sub Command0_Click()
On Error GoTo csv_import_err
Dim objExcel As Excel.Application
Set objExcel = New Excel.Application
Dim strfilename As String
strfilename = objExcel.Application.GetOpenFilename("Select CSV file, *.csv", , "CSV files")
 
[COLOR=Red]'If CANCEL is clicked[/COLOR]
Select Case strfilename
	Case False
	GoTo end_
	Case Else
	GoTo CONT
End Select
 
CONT:
 
[COLOR=Red]'If selected file is open, abort program[/COLOR]
If IsFileOpen(strfilename) Then
MsgBox "The file you have selected is open. Please close this file and run program again.", vbInformation, "Program Error"
GoTo end_
End If
 
[COLOR=Red]'Format CSV file[/COLOR]
Set objworkbook = objExcel.Workbooks.Open(strfilename, , False)
objExcel.Columns("A:B").Insert Shift:=xlToRight
objExcel.Range("A5").FormulaR1C1 = "Account No"
objExcel.Range("B5").FormulaR1C1 = "Invoice No"
objExcel.Range("A6:A" & objExcel.Range("C65536").End(xlUp).Row).FormulaR1C1 = objExcel.Range("D1").Value
objExcel.Range("B6:B" & objExcel.Range("C65536").End(xlUp).Row).FormulaR1C1 = objExcel.Range("F1").Value
objExcel.Rows("1:4").Delete Shift:=xlUp
objExcel.Range("AE1").FormulaR1C1 = "Second Ref"
objExcel.Range("AF1").FormulaR1C1 = "Third Ref"
objExcel.Application.ActiveWorkbook.Close True
 
[COLOR=Red]'Import CSV file to Access table[/COLOR]
DoCmd.TransferText acImportDelim, , "tbl_invoice_dat", strfilename, True
MsgBox "CSV file..." & vbNewLine & vbNewLine & strfilename & vbNewLine & vbNewLine & "...has been imported.", vbInformation, "Import Complete"
end_:
Set objExcel = Nothing
Set objworkbook = Nothing
Exit Sub
csv_import_err:
MsgBox "The following error has occurred." & vbNewLine & vbNewLine & Err.Number & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Please check the CSV file that needs importing.", vbCritical, "Program Error"
Set objExcel = Nothing
Set objworkbook = Nothing
End Sub

I'm still very novicey at this so you may find some code which could be written better. This works very well for me though.

If you wish to comment, please do. I'm always willing to learn new ideas.

The function was found at Ivan F. Moala's website.

Rgds,
Paul.

 

[ghudson]

Thanks! That will come in handy one day for sure.

 

[The_Doc_Man]

I won't comment on the other code, but the IsFileOpen is absolutely correct. By using the file system to open the file, you are "cooperating" with the file locking system. If you CAN open the file with full read-write locking, it is not locked by anyone else. This is the correct approach. Let the file system work FOR you, not AGAINST you.

Other readers and browsers, notice this fine point. It is a very important principle. By letting the file system do some of the complex work and then letting it tell him when there is a problem, LEXCERM has avoided re-invention of an otherwise very complex wheel. This is not a trivial issue. Since the file system handles file locks, the best way to find out about existing file locks is through the file system. Good move, LEXCERM!

 

[LEXCERM]

Hi there,

GHUDSON...no thanks needed. People have helped me so much on this forum, it is an invaluable source. Just browsing FAQ's and other threads is sufficient to answer a majority of my questions.

THE DOC MAN...thank you for explaining the concept of the function code. I digested many threads relating to this and had many replies from other board members on other forums. The one I used (found at Ivan F. Moala's website) seemed the way to go.

Kind rgds,
Paul.