Solved: If wb is open give message

[Emoncada]

I have the following code


Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

If bIsBookOpen_RB("Master.xlsx") Then
Set DestWB = Workbooks("Master.xlsm")
Else
Set DestWB = Workbooks.Open("I:\Excel\Cabinet\Master.xlsm")
End If

It works well, but I would like to see if I can add a msgbox so if that file is currently open by someone it will let the the user know.

[Bob Phillips]

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

Sub test()
If Not IsFileOpen("C:\MyTest\volker2.xls") Then
Workbooks.Open "C:\MyTest\volker2.xls"
End If
End Sub

[Emoncada]

Thanks for the reply XLD, but I'm still having the problem when someone else has the file open it prompts the user to save the file, since it's Read-Only.
I would like to have it prompt the user that the file is currently open by someone else and to retry later.

I modified you code to this.

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

If Not IsFileOpen("I:\Excel\Cabinet\Master.xlsm") Then

Set DestWB = Workbooks("Master.xlsm")
Else

Set DestWB = Workbooks.Open("I:\Excel\Cabinet\iMac Master.xlsm")

End If

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("Unreported").Range("A5:F300")

'Change the sheet name of the database workbook

'---If Tommy
If Environ("Username") = "TommyC" Then

Set DestSh = DestWB.Worksheets("Tommy")

End If

'---If Peter
If Environ("Username") = "PeterF" Then

Set DestSh = DestWB.Worksheets("Peter")

End If

Lr = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
Set DestRange = DestSh.Range("A" & Lr + 1)

With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value
DestSh.Range("A1").Value = "Last Updated by " & Environ("Username") & " " & Now
DestWB.Close savechanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With


Call UpdateLog

End Sub



Can this be done?

[Bob Phillips]

Your code should be along the lines of

Sub ProcessFile()
Dim DestWB As Workbook

On Error Resume Next
Set DestWB = Workbooks("Master.xlsm")
On Error GoTo 0
If DestWB Is Nothing Then

If IsFileOpen("I:\Excel\Cabinet\Master.xlsm") Then

MsgBox "File not available"
Else

Set DestWB = Workbooks.Open("I:\Excel\Cabinet\iMac Master.xlsm")

'rest of your code here
End If
End If
End Sub

[Emoncada]

That Worked.

Thanks XLD

[Emoncada]

Can anyone see why I am having issues with this code on a Windows 7 excel 2010? I am not having issues with Windows XP and excel 2007.

I think it can have something to do with the Environ("Username"), but im not sure.

Sub Copy_To_Another_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Change the file name (2*) and the path/file name to your file
If bIsBookOpen_RB("Master.xlsx") Then
Set DestWB = Workbooks("Master.xlsm")
Else
Set DestWB = Workbooks.Open("I:\Excel\Cabinet\Master.xlsm")
End If
'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("Unreported").Range("A5:F300")

'Change the sheet name of the database workbook

'---If Tommy
If Environ("Username") = "TommyC" Then

Set DestSh = DestWB.Worksheets("Tommy")

End If

'---If Peter
If Environ("Username") = "PeterF" Then

Set DestSh = DestWB.Worksheets("Peter")

End If

Lr = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
Set DestRange = DestSh.Range("A" & Lr + 1)

With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value
DestSh.Range("A1").Value = "Last Updated by " & Environ("Username") & " " & Now
DestWB.Close savechanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With



Call UpdateLog

End Sub

Getting Error in RED
Run-Time error '91':
Object variable or With block variable not set

Any ideas what's causing this?

[Bob Phillips]

This code looks suspect

If bIsBookOpen_RB("Master.xlsx") Then
Set DestWB = Workbooks("Master.xlsm")
Else
Set DestWB = Workbooks.Open("I:\Excel\Cabinet\Master.xlsm")
End If

You say that you think it is to do with Environ("Username") but highlight in red a row that sets the lastrow variable.

Where exactly are you getting the problem?