IsFileOpen - Sub or function not defined error

[furstukin]

I am trying to make an order entry spreadsheet that will open a blank order form spreadsheet and copy information to it then save it as a file based on the customer name and today's date. I ran into a problem if the blank order form spreadsheet is already open it stops to ask if I want to reopen it and loose any changes.

I thought an open file check would be the best way to handle this and so I wrote

If IsFileOpen("C:\JGM (MBA)\Blank Order Form.xlsx") Then
    Windows("Blank Order Form.xlsx").Activate
    Range("A9").Select
    ActiveSheet.Paste
 
    Name = Range("B9").Value & Range("E9").Value
    ChDir "C:\JGM (MBA)\Customer Orders"
    ActiveWorkbook.SaveAs filename:=Name & Format(Date, "mmddyyyy") & ".xls"
 
Else
    Workbooks.Open filename:= _
    "C:\JGM (MBA)\Blank Order Form.xlsx"
    Windows("Blank Order Form.xlsx").Activate
    Range("A9").Select
    ActiveSheet.Paste
 
    Name = Range("B9").Value & Range("E9").Value
    ChDir "C:\JGM (MBA)\Customer Orders"
    ActiveWorkbook.SaveAs filename:=Name & Format(Date, "mmddyyyy") & ".xls" 
End If

But every time i try to test this it comes up with the error "Sub or Function Not Defined" and highlights IsFileOpen("C:\JGM (MBA)\Blank Order Form.xlsx")

I have also tried

Blank = "C:\JGM (MBA)\Blank Order Form.xlsx"
If IsFileOpen("Blank") Then...

But it has the same error. I am not sure what is wrong but as always any help is appreciated.

 

[GTO]

Could you show the code for the function IsFileOpen?

 

[furstukin]

Could you show the code for the function IsFileOpen?

That may be my problem. I don't have any function code as I did not know it was a function. I got the "If IsFileOpen(Blank) Then" statement from a microsoft site. It said just put the code in to do a file check and I of course modified it to do what I want. But even leaving the code as they had it still got the error.

Is this something I have to build a function to pull off? If so I may just need to find a new way to do the file check as I don't know much about creating functions.

 

[GTO]

If you can find the page where you found the code again, look around on the page and you should find the function. It appears (by the arg you supplied in the call) that the function has one parameter, so it may look something like:

Function IsFileOpen( SomeWordHere as String) as Boolean
     '...some code that includes IsFileOpen = True if a test is passed
End Function

If you have a time getting it to work, you could place a link or simply include the code to the fucntion.

 

[furstukin]

If you can find the page where you found the code again, look around on the page and you should find the function. If you have a time getting it to work, you could place a link or simply include the code to the fucntion.

Here is the link to the page I got the code from.
http://support.microsoft.com/kb/291295

At the bottom there is what I thought was a different way to make it work. I didn't think they were related at all. But it says this

' 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

I however am finding it does not work as advertised lol.

I just tested the whole thing written as this

Sub FileCheck()
If IsFileOpen("C:\JGM (MBA)\Blank Order Form.xlsx") Then
    Windows("Blank Order Form.xlsx").Activate
    Range("A9").Select
    ActiveSheet.Paste
 
    Name = Range("B9").Value & Range("E9").Value
    ChDir "C:\JGM (MBA)\Customer Orders"
    ActiveWorkbook.SaveAs filename:=Name & Format(Date, "mmddyyyy") & ".xls"
 
Else
    Workbooks.Open filename:= _
    "C:\JGM (MBA)\Blank Order Form.xlsx"
    Windows("Blank Order Form.xlsx").Activate
    Range("A9").Select
    ActiveSheet.Paste
 
    Name = Range("B9").Value & Range("E9").Value
    ChDir "C:\JGM (MBA)\Customer Orders"
    ActiveWorkbook.SaveAs filename:=Name & Format(Date, "mmddyyyy") & ".xls"
End If
 
End Sub
 
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.
    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.
    Select Case errnum
        Case 0
         IsFileOpen = False
        Case 70
            IsFileOpen = True
        Case Else
            Error errnum
    End Select
End Function

The first time it worked just fine then errored out when it got to ActiveSheet.Paste because there was no data to paste. That left the file open so I tried to run it again and to see how it works when the blank order form was already open. And it acted as if it was were not open and still tried to open it. That gave me the same error I was trying to avoid with this code. Not sure where the issue may lie, but again I appreciate any help you can provide.

 

[GTO]

Okay, just a couple of questions before we take a stab at it.

What is on the clipboard and how did it get there? Do we really need to paste, or are we just getting a value from some other cell?

Finally, in reference to checking to see if the destination wb is open: Are we worried that someone else will have it open (on another PC), or are we just checking to see if we have it open on the same PC that this code is running on?

Mark

 

[furstukin]

Okay, just a couple of questions before we take a stab at it.

What is on the clipboard and how did it get there? Do we really need to paste, or are we just getting a value from some other cell?

Finally, in reference to checking to see if the destination wb is open: Are we worried that someone else will have it open (on another PC), or are we just checking to see if we have it open on the same PC that this code is running on?

Mark

The info that is copied is a completed order form. Once you are done with the order there is a button to hit complete order. That will have the macro copy the range A9:H50 and it pastes that into the blank order form. As far as being worried others will have the file open. No not at all. This will not be run on a server. All the files are on a local machine that will not be shared with anyone.

 

[GTO]

Hi furstukin,

I did not have time to test (sorry, just busy day), but here is a quick stab.

Option Explicit
    
Sub FileCheck()
Dim wbDestination As Workbook
Dim wksDestination As Worksheet
    
    
    '// Skip errors just long enough to see if wb if already open.  wbDestination will  //
    '// return Nothing if not succesfully set.                                          //
    On Error Resume Next
    Set wbDestination = "Blank Order Form.xlsx"
    On Error GoTo 0
    
    '// If not set, open and set a reference to the destination wb.                     //
    If wbDestination Is Nothing Then
        Set wbDestination = Workbooks.Open("C:\JGM (MBA)\Blank Order Form.xlsx")
    End If
    
    '// Your code appeared to depend on opening the wb to the correct sheet.  Better to //
    '// explicitly set a reference to the sheet you want the stuff plunked onto.        //
    Set wksDestination = wbDestination.Worksheets("The sheet name of where you want the data plunked in")
    
    '// As we appear to be only interested in "copying" values (not formulas, formatting and such), //
    '// this is quicker and doesn't depend on the clipboard.                                        //
    wksDestination.Range("A9:H50").Value _
        = ThisWorkbook.Worksheets("source worksheet name here").Range("A9:H50").Value
    
    '// WARN:  I see that I missed including assigning a value to the variable "Name", so don't     //
    '// forget to fix that.  Just an "IMO", but .Name is a property of many objects, so I would use //
    '// something like strFileName or similar.                                                      //
    wbDestination.SaveAs "C:\JGM (MBA)\Customer Orders\" & Name & Format(Date, "mmddyyyy") & ".xls"
    
    wbDestination.Close
    
End Sub

I would note that as we are not worried about the file being open on a network, we just need to see if the file already exists in the workbooks collection.


Hope that helps a little,

Mark

 

[furstukin]

I would note that as we are not worried about the file being open on a network, we just need to see if the file already exists in the workbooks collection.


Hope that helps a little,

Mark

Thanks I am sure I can test it and make it work. THank you for pointing me in the irght direction.

 

[hiepphat]

you try this function

Public Function IsFileOpen(ByVal sFileName As String) As Boolean
Try
Dim FS As IO.FileStream = IO.File.Open(sFileName, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.None)
FS.Close()
FS.Dispose()
FS = Nothing
Return False
Catch ex As IO.IOException
Return True
End Try
End Function