Is there a simple way to check whether a particularly-named spreadsheet is open in the current Excel session, from VBA?
Dim wBook As Workbook
'Check that Summary worksheet is available for update.
on error goto ErrHandler
Set wBook = Workbooks("CommittedSummary.xls")
If wBook Is Nothing Then
msgbox("Not Open")
Else 'It is open
MsgBox("The 'CommittedSummary.xls' workbook is already in use and
cannot be updated. Please try again when the workbook Is available", _
vbCritical, "Committed Request Edit") : exit sub
End If
errhandler: msgbox("Workbooks is already open"):exit sub
Use error handling as below
Sub Working()
Dim Wb As Workbook
Dim strFile As String
strFile = "X.xls"
On Error Resume Next
Set Wb = Workbooks(strFile)
On Error GoTo 0
If Not Wb Is Nothing Then
MsgBox strFile & " is open in this Excel instance"
Else
MsgBox strFile & vbNewLine & " is Closed in this Excel instance", vbCritical
End If
End Sub
Don't use On Error Resume Next
Just because the code will crashes at that line doesn't mean the workbook is not actually open. It just means your code crashed.
If you have two instances of Excel.Application each instance with have a workbooks collection. And might not be looking in the right workbooks collection. Then your code will crash. There could be other reasons why your code crashes.
Don't use Error handers in the normal flow of your code it's bad programming and it'll lead to problems. Error handling is for problems that are unforeseen.
Related
I am trying to open Excel and use information in multiple sheets at different times to automate a Word document.
Judging by the status of the local variables through debugging, Excel seems to launch successfully and the Workbook object is also assigned successfully. However, when the "DB Schedules" worksheet is activated, the ActiveSheet variable remains empty and fails to use the property "Name", instead throwing an "Object Required" error and jumping to the finally block.
The path of the workbook and the name of the sheet are both correct, yet even before activating an arbitrary sheet the ActiveSheet variable is empty. The sheet is known to contain information, and I have tried with multiple files just to be sure.
Sub CompileReport()
Dim XLInstance As Object
Dim XLWorkbook As Object
Dim XLPath As String
XLPath = "C:\Users\SaracchiG\OneDrive - AECOM\Documents\M11 Jn7A\GC300 Certificates\" & _
"Construction Compliance\Certificates Data Project_Name.xlsx"
On Error Resume Next
Set XLInstance = GetObject(, "Excel.Application")
XLInstance.Quit
If Err Then
Set XLInstance = CreateObject("Excel.Application")
End If
On Error GoTo Finally
Set XLWorkbook = XLInstance.Workbooks.Open(XLPath, ReadOnly:=True)
'Testing it all works (doesn't!)
XLWorkbook.Worksheets("DB Schedules").Activate
MsgBox ActiveSheet.Name
MsgBox ActiveWorkbook.Name
'Do some stuff with different sheets
Finally:
XLWorkbook.Close
XLInstance.Quit
End Sub
You don't have to activate the sheet to work with it
'Do some stuff with different sheets
With XLWorkbook.Worksheets("DB Schedules")
MsgBox .Name
MsgBox .Parent.Name
End With
I've encountered a strange thing: I've joined three workbooks: Personal Data Tracker, Global Tracker and the workbook with pivots and charts. The logic is as it follows: the user clicks on a button after the work is finished so the data is copied to the GL Tracker. Once the change event is triggered in the GL Tracker Table, the last workbook opens, the pivot is refreshed upon the open vent and the wb is closed.
Everything seems to be working fine, however when I run the macro live, at the very end I get an error message about
"Application-defined or object-defined error".
Only OK and Help button displayed, it doesn't make the VBE Open so I could debug it.
Would anyone know what it may be happening even if the whole chain works fine?
Thank you.
Code from the Personal Tracker:
Sub test()
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\Dest.xlsm"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Total").Range("R1").Value = Date
Range("R1").Font.Color = VBA.ColorConstants.vbWhite
Worksheets("TOTAL").Range("B2:B13").Copy
On Error GoTo Handler
Workbooks.Open (path)
On Error GoTo 0
Set wb = Workbooks("Dest")
Worksheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
Exit Sub
Handler:
MsgBox "Someone else is saving their data at the moment." & vbNewLine & _
"Please try in a few seconds"
End Sub
Code from the GL Tracker:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Dim wbPivot As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
Dim Name As String
Dim answer As VbMsgBoxResult
Set MRange = ThisWorkbook.Sheets(1).Range("Table1")
Name = Application.UserName
Application.ScreenUpdating = False
If Not Intersect(Target, MRange) Is Nothing Then
Application.EnableEvents = True
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Pivot.xlsm")
End If
'refresh
For Each ws In wbPivot.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.Refresh
pt.Update
pt.RefreshTable
Next
Next
'saving
Application.ScreenUpdating = True
If Application.UserName <> "Jakub Tracz" Then
MsgBox "User not authorised. Workbook will be closed."
wbPivot.Close True
ThisWorkbook.Close True
Else
answer = MsgBox(Prompt:="Do you want to save and close the workbook?", _
Buttons:=vbYesNo + vbQuestion)
Select Case answer
Case vbYes
wbPivot.Close True
ThisWorkbook.Close True
Case vbNo
MsgBox "Welcome, " & Application.UserName
End Select
End If
End Sub
I'm going to give you a proof of concept code as an example for you to use. This will not exactly answer your question with code you can just copy/paste, but you will be able to use this to put it together the way you want it to work instead of me making assumptions about many things and restructuring it myself.
This simply demonstrates how to use a workbook object variable in one routine that can reference another workbook, and how to make changes to that 2nd workbook and save/close it.
Sub Tracker_Update()
Dim wbPivot as Workbook
' open the workbook
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Test.xlsx")
' optionally make it hidden
wbPivot.Visible = False
With wbPivot
' pretend this code updates the pivot table
.Worksheets(1).Range("A1") = "hello world"
' Close and save it
.Close True
End With
' optionally clear the variable
' this is not really needed in VBA, but if you eventually
' start using VB.NET with Excel as a COM object,
' you will want to know how to do this part when you are done
Set wbPivot = Nothing
End Sub
I think you will like this approach in the end much better in the end anyway, as the code isn't scattered around so much in different places. Easier to debug later, and easier for someone else to understand what you are doing if and when you leave the company.
The following code used to work, but now returns a Runtime Error 1004.
Sub ResizeListObject_DateRange()
' Do Some things ...
Call HubLink.HubLaunch
Application.Run "'" & MacroHub & "'!" & "ResizeListObject", TableName, LstRow
Call HubLink.HubClose
End Sub
Below is the HubLaunch sub. It opens a second workbook that includes a macro that is then asked to run.
I can avoid the runtime error by commenting out the line "Call HubLink.HubLaunch" and instead manually open the MacroHub.xlsm file (via File > Open > [Choose My File]) before executing sub "ResizeListObject_DateRange".
In the immediate window I verified that ?Workbooks.Count = 2. I do not understand why my HubLaunch sub is opening the MacroHub.xlsm workbook in such a way that its Macros are inaccessible to the first workbook.
Can anyone explain the error?
Thanks.
' Opens the Workbook that stores all common macros
Sub HubLaunch()
' The current workbook
Dim WkBk As String
WkBk = ActiveWorkbook.Name
Dim WkBk_Hub As Workbook
' If not already launched, open the Common workbook that stores all common macros
On Error Resume Next
Set WkBk_Hub = Workbooks(MacroHub_Path & MacroHub_FName)
On Error GoTo 0
If WkBk_Hub Is Nothing Then
Set WkBk_Hub = Workbooks.Open(MacroHub_Path & MacroHub_FName)
End If
' Reselect the calling workbook
Workbooks(WkBk).Activate
End Sub
I have an Excel macro that creates another workbook for the user to modify. When I try to enter data in a cell in the new workbook, however, I get the error "The cell or chart you're trying to change is on a protected sheet." The sheet in the macro workbook is, in fact, protected, but that sheet is not visible at the time I get the error. When I try to close the visible, newly created workbook, it’s the macro workbook that closes. The last thing my macro does is activate the sheet in the new workbook. What do I have to do to make that work? Having the macro close its own workbook solves the problem, of course, but that’s not what I want to do, since the user needs another macro in the same workbook to process the changes on the new sheet.
The program has over 6000 lines of code (so far), but here is one of the routines that causes the problem.
Private Sub z3_BudgetPrepUpd()
'Build a new workbook initialized to let the user modify data
'for an existing fiscal-quarter budget.
'When this routine executes,
' UserForm1 is still active.
Dim strTracer As String 'error-handling tracer for this subroutine
Dim strFyrQtr As String
On Error GoTo abend
If blnAbort Then Exit Sub
If blnAbortGlobal Then Exit Sub
'Find out which ListBox item the user selected:
If UserForm1.ListBox1.ListCount < 1 Then GoTo aa9000 'ListBox is empty
If UserForm1.ListBox1.ListIndex < 0 Then 'No item selected
strMsgTitle = udtPrm.msgTtl
strMsgPrompt = "Please select a fiscal quarter to update."
Call z0_MsgBox
GoTo aa9000
End If
strFyrQtr = UserForm1.ListBox1.Value 'Selected item in ListBox
'Close UserForm1:
UserForm1.Hide
ThisWorkbook.Sheets(c_WKS_WELCOME).Activate
'Build the udtBgt() array with data for the specified quarter:
lngBgtHiNdx = -1
Call zz_GetBudgetForQtr(strFyrQtr)
If blnAbort Then GoTo aa9000
'Build a new workbook for the user to update budget amounts:
Workbooks.Add
Set wkbNewBook = ActiveWorkbook
'Save the names of the default worksheets
'so we can delete them later:
strDfltSheets() = z0_SheetNames(wkbNewBook)
'Build a worksheet with data from the udtBgt() array:
Call z3_BuildBudgetUpdSheet
If blnAbort Then GoTo aa9000
'Delete the default worksheets:
Call z0_DeleteSheets(wkbNewBook, strDfltSheets())
If blnAbort Then GoTo aa9000
wkbNewBook.Sheets(c_WKS_IPT_BUDGET).Activate
'Excel 2016 Bug:
'We need to close ThisWorkbook to allow the user
'to work with the book we just created:
Application.DisplayAlerts = False
ThisWorkbook.Close
aa9000:
Exit Sub
abend:
lngErr = Err.Number
strErr = Err.Description
blnAbort = True
Application.Cursor = xlDefault 'no more hourglass
strMsgTitle = "Program Error"
strMsgPrompt = "The following error occurred:" & Chr(10) & Chr(10) & _
"Error No. " & CStr(lngErr) & Chr(10) & _
"Error Description: " & strErr & Chr(10) & _
"Subroutine: z3_BudgetPrepUpd" & Chr(10) & _
"Tracer: " & strTracer
Call z0_MsgBox
Resume aa9000
End Sub
You use ThisWorkbook which I agree with. You use ActiveWorkbook which I hardly ever use.
I'd recommend using a variable to store reference to workbooks other than that which houses your code. So use
Dim wb As Excel.Workbook
Set wb = Application.Workbooks.Open("c:\test.xlsm") 'for opening
'* or
Set wb = Application.Workbooks.Add 'for creating a new one
'* or
Set wb = Application.Workbooks.Item("AlreadyOpen.xlsm") 'for referencing one already open
'* from hereon use wb instead of ActiveWorkbook
wb.Worksheets.Item(1).Visible = True
Thanks, everyone, for your interest and suggestions. I have solved the problem by redesigning the application without UserForms or external workbooks. Office 2016 has many issues, and perhaps this is one of them. In any case, I have no more time to research it.
I open a workbook by using TASK MANAGER. Sometimes the previous task is not completed i.e. the macro is already running in another workbook.
I want to check if any other workbook is already open or running macro; close current opened workbook by task manager.
I have simple code as per below:
If thisworkbook.name <> activeworkbook.name then
call sendemail ' don't need code
else
Call Run_Dashboard
End if
Dim wb as Workbook
On Error Resume Next '//this is VBA way of saying "try"'
Set wb = Application.Workbooks(wbookName)
If err.Number = 9 then '//this is VBA way of saying "catch"'
'the file is not opened...'
End If
Function Is_Workbook_Open(byval WB_Name as String) as Boolean
Dim WB as Workbook
For each WB in Application.Workbooks
if WB.Name = WB_Name then
Workbook_Open = True
Exit Function
End if
Next WB
End Function
Answers True if the Workbook is opened, no error handling.