Solved: If file is open, can the Thisworkbook open event save a copy and leave it open?

[frank_m]

When a file is not available because another user has it open, I would like to have a Thisworbook open event that gives the option of saving a copy with the users name or the Computer name appended to it, and leaves the copy open.

Hope it's not much trouble.

Thank you much.

[Bob Phillips]

[vba]

Private Sub Workbook_Open()
Dim wb As Workbook

If IsFileOpen("C:\MyTest\MyBook.xls") Then
Set wb = Workbooks.Open(FileName:="C:\MyTest\MyBook.xls", ReadOnly:=True)
wb.SaveAs "C:\MyTest\MyBook2.xls"
End If
End Sub

Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function
[/vba]

[frank_m]

Hi Bob.

Thanks for the assistance. I tried to modify your code to use the name of the workbook that the user is trying to open, rather than a pre-determined name, but I failed with my attempts.

The code I put together below accomplishes what I want, with the only issue being that if the user cancels, a new workbook is left open.
(How might I avoid that?)

I put this together by rearranging and hacking up parts of some code that member Ken Puls wrote for me for a different task, so I do realize I likely have used more commands than necessary.
[vba]Private Sub Workbook_Open()

Dim sFileName As String
Dim sFileExt As String
Dim i As Integer

sFileExt = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, ".") + 1)

sFileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(sFileExt))

sFileName = sFileName & "_" & Environ("COMPUTERNAME") & Format(Now, "_yyyy-mm-dd hh-nn-ss")

sFileName = ThisWorkbook.Path & Application.PathSeparator & sFileName & sFileExt

If ThisWorkbook.ReadOnly = True Then

i = MsgBox("Workbook being edited by another user" & Chr(13) & _
"Would you like to save a copy with your computername, date and time appended to it?", _
vbQuestion + vbYesNoCancel, "Excel")

Select Case i

Case vbYes
ThisWorkbook.SaveAs sFileName

Case Else
ThisWorkbook.Close
'If I use Application.Quit here, will I be risking closing other workbooks?
End Select

End If

End Sub
[/vba]

[Bob Phillips]

Cancels what Frank, the MsgBox or the SaveAs?

[frank_m]

Hi Bob,

My concern was that if I selected No, or cancel from the msgbox, I was left with an instance of Excel and/or a new workbook open.

I just tried it again now, but with the Application.quit command added, and all seems to the working as I want. - The reason that I was hesitant to use .quit was I thought that might close other workbooks that may have previously been opened. - It seems I was wrong.

As far as i can tell I'm ok now. -- Thanks for looking at it for me.
[vba]
Private Sub Workbook_Open()

Dim sFileName As String
Dim sFileExt As String
Dim i As Integer

sFileExt = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, ".") + 1)

sFileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(sFileExt))

sFileName = sFileName & "_" & Environ("COMPUTERNAME") & Format(Now, "_yyyy-mm-dd hh-nn-ss")

sFileName = ThisWorkbook.Path & Application.PathSeparator & sFileName & sFileExt

If ThisWorkbook.ReadOnly = True Then

i = MsgBox("Workbook being edited by another user" & Chr(13) & _
"Would you like to save a copy with your computername, date and time appended to it?", _
vbQuestion + vbYesNoCancel, "Excel")

Select Case i

Case vbYes
ThisWorkbook.SaveAs sFileName

Case Else
ThisWorkbook.Close
Application.Quit ' using quit seems to have solved my problem without any ill affects
End Select

End If

End Sub[/vba]

[Bob Phillips]

Quit should quit the app, so are you starting a new Excel instance?

When I tried it, it worked fine on Cancel, I cannot see where your new workbook is coming from.

[frank_m]

HI again Bob,

I want the code to work regardless of whether the file is opened by clicking on it in windows explorer, or opening it from a running workbooks file menu, and it is. - In other words, all is fine. - The issue of a new workbook being left open, I am sure was in my imagination. I think had opened a new workbook by another means and became confused.

I'm going to mark this solved

Thanks for your help and assistance.