How to run macro from another spreadsheet and wait for execution? - excel

I have a spreadsheet (let's name it Spr1) that I need to refresh periodically. I don't want to refresh it every time I open it, because it takes time.
I created another "launcher spreadsheet" (Spr2) to start Spr1 with macro in argument.
Spr2 is opening with:
Private Sub Workbook_Open()
Application.Visible = True
Application.Run "'\\path\Spr1.xlsm'!Refresh_data"
Workbooks("Spr1.xlsm").Close SaveChanges:=True
Application.Quit
End Sub
Macro in Spr1:
Sub Refresh_data()
ThisWorkbook.RefreshAll
End Sub
The first macro is not waiting for second one to finish the refresh. It is terminating Excel right after opening Spr1.
How can I wait to finish "Refresh_data"?

It depends on type of default you have set.
Find your Query Properties, and set 'Enable background refresh' to False (Microsoft use True as default).
Then in your code you need to call for RefreshAll and wait for the data to load with the DoEvents. If you want your update of data to run on open you can use this in 'ThisWorkbook' Object.
Private Sub Workbook_Open()
For Each q In ThisWorkbook.Connections
q.Refresh
DoEvents
Next
End Sub

If you like to launch your update from a VBScript you can call your macro without even se Excel doing the work in the background. Use Notepad and past this code in and save as MyStarter.vbs where you can start it with a double click.
Dim xlApp
Dim xlWkb
Dim MyParam
MyParam = InputBox("Input your Parameter:","Enter parameter to the service")
if MyParam <> false then
Set xlApp = CreateObject("excel.application")
Set xlWkb = xlApp.Workbooks.Open("\\path\Spr1.xlsm",true,true)
xlApp.Run "Spr1.xlsm!Refresh_data", CStr(MyParam)
Set xlWkb = Nothing
Set xlApp = Nothing
end if
Then you can use your input parameter sent to the instance of your workbook like this :
Sub Refresh_data(MsgFromVBScript As String)
MsgBox ("This is your parameter from VBScript:" & MsgFromVBScript)
ThisWorkbook.RefreshAll
End Sub

Related

Excel Workbook opens as Read-Only because Connection Files

I have an group of 3 interconnected workbooks that pull data from each other. The way I have it pulling data is through Connections. All files are located in the same drive. What I am trying to do is to open all three files at the same time to make edits. However, once I open workbook "A", I can not properly open files "B" or "C" as it displays that the file is in use by another user and only gives the option to open as Read-Only.
Is there a work around to open all files at the same time in Write mode? I have tried including a ChangeFileAccess to Read but that does not work.
Thanks!
UPDATE:
I linked all files using Data > Connections. To further expand, these files open as UserForms on startup and I have added this code under "ThisWorkbook" to do that (open the UserForm automatically and hide the workbook). I am beginning to think that my problem of not being able to open more than one of this documents at the same time is because of this piece of code, but I am not sure what it might be or if there's a better way to open Userform & hide workbook. Any advice is appreciated. Below is the code I have under "ThisWorkbook":
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'important to reset this
Application.IgnoreRemoteRequests = False
End Sub
Private Sub Workbook_Open()
'need to use ontime to allow xl to initialise fully
Application.OnTime Now, "ThisWorkbook.OnlyOneOfMe"
End Sub
Private Sub OnlyOneOfMe()
Dim xlApp As Excel.Application
On Error GoTo BAD
With Application
If Me.ReadOnly Or .Workbooks.Count > 1 Then
Me.ChangeFileAccess Mode:=xlReadOnly
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Open (Me.FullName)
GoTo BAD
Else
'stop opening from explorer (but not from excel)
.Visible = False
.IgnoreRemoteRequests = True
UserForm1.Show
.Visible = True
'.Quit
End If
Exit Sub
End With
BAD: If Err Then MsgBox Err.Description, vbCritical, "ERROR"
Set xlApp = Nothing
Me.Close False
End Sub

I want to run a macro in my personal macro workbook automatically

Sub Auto_Run
If Weekday(Now()) =6 then
Application.OnTime TimeValue(“15:15:00”), “DCSReport”
End If
End sub
Sub DCSReport
‘My code
End sub
How do I get it to run every Friday at 3:15?
Running VBA code at a specific time with Excel only is kind of risky, because many things can happen. Probably it is a simpler and better idea to do it through the task scheduler or through some kind of cloud service.
Anyway if you are willing to risk, here is a work-around:
Dedicate a separate spreadsheet, named "Log" in order to log the weeks in which the code was run. To make the weeks unique, add the year - Year(Now()) & WorksheetFunction.WeekNum(Now())
Make some kind of an event in the workbook, which is not triggered often - E.g. Workbook_AfterSave could do the job
Make a few checks in the Event, making sure that it would run at the specific time and day: If Weekday(Now()) = vbFriday And Time > ("15:15:00") And notSavedThisWeek Then
Code in the ThisWorkbook:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Weekday(Now()) = vbFriday And Time > ("15:15:00") And notSavedThisWeek Then
DCSReport
LogThisAction
End If
End Sub
Sub LogThisAction()
With Worksheets("Log")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lastRow, 1) = weekYearNumber
End With
End Sub
Function notSavedThisWeek() As Boolean
With Worksheets("Log")
Dim someRange As Range
Set someRange = .Cells.Find(What:=weekYearNumber)
notSavedThisWeek = CBool(Not someRange Is Nothing)
End With
End Function
Function weekYearNumber()
weekYearNumber = Year(Now()) & WorksheetFunction.WeekNum(Now())
End Function
Sub DCSReport()
Debug.Print "Code"
End Sub
There's a number of ways to approach running VBA macros automatically on a schedule. I find the simplest and easiest way to do it is with good old Windows Task Scheduler. You will need:
A .VBS file which opens your workbook and starts your macro
A Scheduled Task in Task Scheduler which executes that .VBS file using the CSCRIPT command
An example .VBS file might look like this:
Option Explicit
Dim xlApp
Dim xlBook
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open("\\Location-Of\Your\Personal-Macro-Workbook.xlsm", 0, False)
xlApp.Run "NameOfYourMacro"
xlApp.Application.EnableEvents = False
xlBook.Close False
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
WScript.Quit
Just create that in Notepad or whatever your preferred text editor is and save it as a .VBS file
Then in Windows Task Scheduler, create a basic task.
The name, Description, Trigger (schedule) are all up to you, but in "Action" you need to select "Start a Program", then just type "cscript" in the "Program/script" box, and in "Add arguments (Optional)" you put the full path and filename for your .VBS file. Making sure you surround that in Quotation marks.

Msgbox not closing when WSH.Popup waits for certain time

I have an Excel file that opens automatically with Windows Scheduler. Also I have an Auto_Open sub to run a macro immediately. To avoid that every time it opens it starts running without a chance to modify it, I set up a msgbox that let me choose if the macro runs or not. However, I want Excel to automatically choose "Yes" after 10 seconds have passed, and I'm not able to get it. This is my code:
I have tried to place the seconds directly without a variable, I have also tried Case -1 alone, yet nothing works.
Sub Auto_Open()
Set WSH = CreateObject("WScript.Shell")
'cTime = 10
BtnCode = WSH.Popup("¿Desea generar la consulta de vacaciones?", cTime, "Consulta", vbYesNo)
Select Case BtnCode
Case vbYes
Call consulta
Case vbNo
Case 1, -1
Call consulta
End Select
End Sub
It might be easier to use a userform in combination with a module to run this. The UserForm would need to replace whatever you're doing with Msgbox. The code you'll need would look something like this:
USERFORM clode
Private Sub CommandButton2_Click()
'Run code for yes
'then
Unload Me
End Sub
Private Sub CommandButton1_Click()
'run code for "no".
'then
Unload Me
End Sub
Private Sub UserForm_Activate()
Application.OnTime Now + TimeValue("00:00:10"), "KeepItGoing"
End Sub
Then you can have it interact with an external module:
Sub launchSOMETHING()
'Run this first
UserForm1.Show
End Sub
Sub KeepItGoing()
If UserForm1.Visible = True Then
MsgBox "BOOOOMO"
Unload UserForm1
End If
End Sub
You can see an example in this file here.
UPDATED: It appears that all macros will pause while Msgbox is open. In the below two procedures, you'll note that the second one won't be triggered until after the box is closed, even though it was supposed to run in 5 seconds.
Sub TestWhatMsgBoxDoes()
Application.OnTime Now + TimeValue("00:00:5"), "someOtherMacro"
MsgBox "Everything is on hold?"
End Sub
Sub someOtherMacro()
Application.StatusBar = "The Second Macro has run at" & Now()
End Sub
I think has to do with the "Call consulta" procedure, try use megbox to test it.
Ok, so after a lot of research I managed to do what I want without a lot of issues.
First, I created a scrip (.vbs file) that contains the following:
Dim objExcel
Dim objWB
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Open("R:path\file.xlsm")
objExcel.Run "MyMacroName"
objWB.Save
objWB.Close False
objExcel.Quit
Now every time I run the script, the macro would run automatically. I have also set up a Windows Scheduler Event so it will run by itself with the script. In that way, I don't need a Popup to ask me if I want to run something, and the script would only run when the Event is triggered by the conditions set.
On the other hand, the Excel file itself is free from autorun when the workbook is opened, so any user can modify it without any problem.
Thanks to the people that helped me through this.

Error handling not working on run-time Error 9 in excel-vba

I want to apply the error handling mechanism in Excel VBA, I want to catch this "runtime error 9", but it's not working.
I am using this userform_initialize() method/sub over and over again, each time I don't want to open this "SAMPLE UPDATE FILE.xlsm" workbook instead, I want to check if it's already open. if yes, then switch to that window or open that workbook.
I have tried on error resume next statement as well but still, it breaks on switching to window "Windows("SAMPLE UPDATE FILE.xlsm "). Select"
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
On Error GoTo OPEN_WB_ERR
Windows("SAMPLE UPDATE FILE.xlsm").Select
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
On Error GoTo 0
Exit Sub
OPEN_WB_ERR:
Workbooks.Open Filename:="X:\SAMPLE UPDATE FILE.xlsm"
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
Resume Next
End Sub
any advice will be helpful...
Check your setting in the VB editor (Tools >> Options >> General tab >> Error Trapping) for how errors are handled - if you have "Break on all errors" selected then it will always break regardless of any error handling you have set. "Break in Class module" is a good option.
Try,
Private Sub UserForm_Initialize()
Dim path As String, Fn As String
Dim Wb As Workbook
Fn = "X:\SAMPLE UPDATE FILE.xlsm"
Set Wb = Workbooks.Open(Filename:=Fn)
UserForm1.ComboBox1.RowSource = "'" & Fn & "'" & "!SEARCH"
ThisWorkbook.Activate
End Sub
The Initialize event procedure runs when the form is first created, before it is shown. You should open your workbook before creating the form, not as part of that process. Try a procedure like the one below, to be installed in a standard code module.
Sub OpenUserForm()
Dim MyForm As UserForm1
' open your workbook here
Set MyForm = New UserForm1 ' this fires the Initialize event
UserForm1.Show
' the code below runs when MyForm is closed
Unload MyForm
Set MyForm = Nothing
End Sub
Note that a form by the name of UserForm1 must exist. I recommend to give it another, more descriptive name. If you do that whatever name you give is the one to use in the Dim statement declaring MyForm.
I use a WorkbookIsOpen function
Public function WorkbookIsOpen(byval strFile as string) as Boolean
Dim wbkCurr as excel.workbook
WorkbookIsOpen = false
For each wbkCurr in application.Workbooks
If wbkCurr.name = strfile then
WorkbookIsOpen = true
Exit for
Endif
Next wbkCurr
End function
Pass just the file name and extension ie myworkbook.xlsx
Then I just adjust my logic accordingly

refresh both the External data source and pivot tables together within a time schedule

In my last post Auto refresh pivottables data in excel on first run, i found that on my first execution the query from the External data source is refreshed and takes approximately 1 min to execute. and in my second run, the pivot tables are updated.
Is there a solution (VBA code) to refresh both the External data source and pivot tables together within a time schedule (If suppose we set a timer) by clicking command button?
Under the connection properties, uncheck "Enable background refresh". This will make the connection refresh when told to, not in the background as other processes happen.
With background refresh disabled, your VBA procedure will wait for your external data to refresh before moving to the next line of code.
Then you just modify the following code:
ActiveWorkbook.Connections("CONNECTION_NAME").Refresh
Sheets("SHEET_NAME").PivotTables("PIVOT_TABLE_NAME").PivotCache.Refresh
You can also turn off background refresh in VBA:
ActiveWorkbook.Connections("CONNECTION_NAME").ODBCConnection.BackgroundQuery = False
I used the above answer but made use of the RefreshAll method. I also changed it to allow for multiple connections without having to specify the names. I then linked this to a button on my spreadsheet.
Sub Refresh()
Dim conn As Variant
For Each conn In ActiveWorkbook.Connections
conn.ODBCConnection.BackgroundQuery = False
Next conn
ActiveWorkbook.RefreshAll
End Sub
I think there is a simpler way to make excel wait till the refresh is done, without having to set the Background Query property to False. Why mess with people's preferences right?
Excel 2010 (and later) has this method called CalculateUntilAsyncQueriesDone and all you have to do it call it after you have called the RefreshAll method. Excel will wait till the calculation is complete.
ThisWorkbook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
I usually put these things together to do a master full calculate without interruption, before sending my models to others. Something like this:
ThisWorkbook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
Application.CalculateFullRebuild
Application.CalculateUntilAsyncQueriesDone
Auto Refresh Workbook for example every 5 sec.
Apply to module
Public Sub Refresh()
'refresh
ActiveWorkbook.RefreshAll
alertTime = Now + TimeValue("00:00:05") 'hh:mm:ss
Application.OnTime alertTime, "Refresh"
End Sub
Apply to Workbook on Open
Private Sub Workbook_Open()
alertTime = Now + TimeValue("00:00:05") 'hh:mm:ss
Application.OnTime alertTime, "Refresh"
End Sub
:)
I found this solution online, and it addressed this pretty well. My only concern is looping through all the pivots and queries might become time consuming if there's a lot of them:
Sub RefreshTables()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim objList As ListObject
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
For Each objList In ws.ListObjects
If objList.SourceType = 3 Then
With objList.QueryTable
.BackgroundQuery = False
.Refresh
End With
End If
Next objList
Next ws
Call UpdateAllPivots
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub UpdateAllPivots()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws
End Sub

Resources