Copy to file already open

[sharky12345]

I'm using this to select an existing Excel file and then go on afterwards to copy data to it.

As you can see, the user is prompted to find their current file and then it is opened, but how can I adjust it so that if it is already open the rest of the code runs without 'reopening' the file and giving the user the message asking if they want to reopen it?

Call MsgBox("Select your existing Toolbox to import data", vbExclamation Or vbDefaultButton1, "Select existing file")
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsm), *.xlsm")
If FileToOpen = "False" Then
ActiveWorkbook.Close SaveChanges:=False
End If
filePath = Left$(FileToOpen, InStrRev(FileToOpen, "\"))
filename = Mid$(FileToOpen, InStrRev(FileToOpen, "\") + 1)
Application.ScreenUpdating = False
Application.EnableEvents = False

 

[daverunt]

Hi.
Might not be exactly what you want.....

Call MsgBox("Select your existing Toolbox to import data", vbExclamation Or vbDefaultButton1, "Select existing file")
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls")
If FileToOpen = "False" Then
ActiveWorkbook.Close SaveChanges:=False
Exit Sub '--------------------------added to your code. 
End If
filePath = Left$(FileToOpen, InStrRev(FileToOpen, "\"))
filename = Mid$(FileToOpen, InStrRev(FileToOpen, "\") + 1)

'Checks if the file is already open confirms use by user if it is or opens if not
    If IsFileOpen(FileToOpen) Then
    
    Response = MsgBox("Use the already open file?" & vbCr & vbCr & "(" & filename & ")" _
    , vbOKCancel + vbExclamation, "File Already Open!")
    
   If Response = vbCancel Then
   Exit Sub
   End If
    Else
        Workbooks.Open FileToOpen
    End If


Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub

 

[sharky12345]

Hi Dave, and thanks, but it's failing on the following line with 'Sub or Function not defined';

IsFileOpen

which is on this line

If IsFileOpen(FileToOpen) Then

 

[daverunt]

Hi,

sorry for the delay getting back.

I forgot to add the function. It's one from Microsoft.

'http://support.microsoft.com/kb/291295
    Function IsFileOpen(filename)
        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

 

[sharky12345]

Perfect, cheers Dave....