Excel crashes when install an addin - excel

Excel AddIn, .NET 4.0, NetOffice 1.5.1.2, ExcelDNA 1.29, C#
installers calls a xls (install.xls) with VBA as follow
At the end of install.xls, Excel will close.
However, after Excel closes, Excel crashes saying "Excel stops working... please send report to Microsoft" with two buttons, one is "Don't Send", the other is send
This ONLY happens on Windows XP + Excel 2007 or WinXP + Excel 2010.
Also during debug I notice if I replace Application.Wait with MsgBox, then there is no crashes issue at all. I feel there is some kind of timing issue but really has no clue no control.
The issue drives me crazy. Please help. thanks!
Private Sub Workbook_Open()
Dim quit As Integer
Dim added As Boolean
added = Add_Addin
Application.Wait (Now + TimeValue("0:00:02"))
If Workbooks.Count = 1 Then
Application.Wait Now + TimeValue("0:00:03")
Application.quit
Else
Application.Wait Now + TimeValue("0:00:03")
Me.Close
End If
End Sub
Private Function Add_Addin() As Boolean
On Error GoTo ERR_
Dim addinFile As String
addinFile = ThisWorkbook.Path & "\" & "MyAdd-In.xll"
If Len(addinFile) > 0 Then
Dim LEA As AddIn
Set LEA = Application.AddIns.Add(addinFile)
If (Not LEA Is Nothing) Then
LEA.Installed = True
Else
MsgBox "Failed to add XLL"
End If
'If (Application.RegisterXLL(addinFile) = True) Then
' MsgBox "Yeah, succeed registering XLL"
'Else
' MsgBox "Failed to register XLL"
'End If
Else
MsgBox "XLL file not found"
End If
addinFile = ThisWorkbook.Path & "\" & "MyFunc.xla"
If Len(addinFile) > 0 Then
Dim LEA2 As AddIn
Set LEA2 = Application.AddIns.Add(addinFile)
If (Not LEA2 Is Nothing) Then
LEA2.Installed = True
Else
MsgBox "Failed to add xla"
End If
Else
MsgBox "xla file not found"
End If
Add_Addin = True
Exit Function
ERR_:
MsgBox ("Error " & Err.Number & " " & Err.Description)
Add_Addin = False
End Function

I figured it out. I kicked off a web service call asychronously with callback When Excel opens. When the callback of the web service call is executed after Excel is disposed or close, the crash occurred. The callback disbales/enables ribbon buttons based on the result from web service. I fixed it by checking if Excel is null or disposed before doing anything else in the callback.

Related

Refreshing Excel Queries with Task Scheduler

I am trying to automate Query refresh in MS Office Professional Plus 2016.
I have a cmd script which runs vbs script which runs Excel macro. Everything works if I run it manually. The problem occurs when I set up Windows Task Scheduler and select the option "run whether user is logged on or not".
My macro is saving query result log to text file so I can determine where the code breaks. Looks to me that Excel displays an alert box (or something similar) when running with Task Scheduler. I can not determine what is expected from user since the scheduler hides all alerts. There are no alerts/prompts if I run the cmd script manually or via Task Scheduler with option "run only if user is logged on".
Here is my RefreshQueries() sub. I tried commenting the code and confirmed that line that breaks the whole automation is .Refresh inside With iTable.QueryTable .
Private Sub RefreshQueries()
AddToLogFile ("Hello from subroutine RefreshQueries().")
Dim iWorksheet As Excel.Worksheet
Dim iTable As Excel.ListObject
'Check each worksheet.
For Each iWorksheet In Excel.ActiveWorkbook.Worksheets
AddToLogFile ("For-loop for iWorksheet " & iWorksheet.Name)
'Check all Objects if it is a query object.
For Each iTable In iWorksheet.ListObjects
If iTable.SourceType = Excel.XlListObjectSourceType.xlSrcQuery Then
AddToLogFile ("Trying to refresh iTable: " & iTable.Name)
QueryTimeStart = Timer
On Error Resume Next
With iTable.QueryTable 'Refresh the query data.
.BackgroundQuery = False
.EnableRefresh = True
.Refresh
End With
If Err.Number <> 0 Then
QueryRunTime = CalculateRunTime("QueryRunTime") 'Stop timer and get the duration.
Call AddToHtmlErrorTable(iTable.Name, Err.Number, Err.Description, QueryRunTime) 'Add entry to error table.
AddToLogFile ("Query in iTable " & iTable.Name & " failed. Description: " & Err.Description)
NumberOfFailedQueries = NumberOfFailedQueries + 1 'IMPORTANT: increment must be after updating html error table!
Err.Clear 'Clear errors between for loops.
Else
NumberOfSuccessfulQueries = NumberOfSuccessfulQueries + 1
AddToLogFile ("Query in iTable " & iTable.Name & " successfully refreshed.")
End If
End If
Next iTable
Next iWorksheet
AddToLogFile ("Exiting subroutine RefreshQueries().")
End Sub
I guess my question is as follows:
can we somehow catch what prompt Excel is showing in the background (nothing pops up if I run it manually), or
can we confirm any shown message in Excel automatically (without knowing what it is), or
are there any known settings which would execute the connection without any confirmation.
Does anyone have an idea, experience, or suggestion regarding this issue?
You need to add error catcher to your VBA routine like described here
Private Sub RefreshQueries()
On Error Goto MyError
' .... All your code
Exit sub
MyError:
'Do your magic here with Err.object to log the event or whatever
AddToLogFile ("#Error in RefreshQueries().:" & Err.Discription)
Resume Next
End Sub

How should I show the Developer tab in Excel using Macros? (Excel VBA)

I am looking for a way to open the Import XML option (highlighted below) through a macro command...
So far, I have tried using Application.SendKeys ("%lt") - it works, but only when one has enabled the Developer tab in the ribbon - and sadly, a lot of my users won't have the tab enabled. So I thought If it's possible to toggle this checkbox - (File >> Excel Options >> Show Developer Tab)
I'll just make the Developer tab visible in my user's Excel, and then use Sendkeys. Or, if this isn't possible, Is there any way I could invoke the Import XML option by any other means in Macro? Invoking the Import XML option is the only reason I am doing all this. Kindly guide... Thanks! :)
You can activate (mode=1) or deactivate (mode=0) the developer tab by changing the DeveloperTools option in the registry.
Sub Test_DeveloperTab()
Call setDeveloperTab(1)
End Sub
Sub setDeveloperTab(ByVal mode As Integer)
Dim regKey As String
regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\options\DeveloperTools"
On Error GoTo errHandler
' If value is equal to existing or different from 0 or 1 then exit
Select Case Registry_KeyExists(regKey)
Case 0: If mode = 0 Then Exit Sub
Case 1: If mode = 1 Then Exit Sub
Case Else: Exit Sub
End Select
' Late Binding
Dim oShell As Object: Set oShell = CreateObject("Wscript.Shell")
If (mode <> 0 And mode <> 1) Then Exit Sub
' Developer Tab: Activate \\ Deactivate
oShell.RegWrite regKey, mode, "REG_DWORD"
exitRoutine:
Exit Sub
errHandler:
Debug.Print Now() & "; " & Err.Number & "; " & Err.Source & "; " & Err.Description
Resume exitRoutine
End Sub
Function Registry_KeyExists(ByVal regKey$) As Variant
' Check if registry key exists
On Error GoTo errHandler
Dim wsh As Object: Set wsh = CreateObject("WScript.Shell")
Registry_KeyExists = wsh.RegRead(regKey)
Exit Function
errHandler:
Err.Raise Err.Number, "Registry_KeyExists", Err.Description
End Function

Excel Macro to "Check-out" from OneDrive Sharepoint

I'm trying to develop a macro that has to "check-out" a sharepoint excel file, open with a preset password, update with some data from an offline file, save and then "check-in" back to sharepoint.
But, I'm stuck at very first step itself that I'm unable "check-out" the file and it throws the below error.
Macro Used:
Sub ExcelUpdater()
FileSharepointLocation = Range("FileLocation").Value
ExcelFilename = "Destination File.xlsb"
FileAddress = FileSharepointLocation + "/" + ExcelFilename
If Workbooks.CanCheckOut(FileAddress) = True Then
Workbooks.CheckOut ExcelFilename
Workbooks.Open Filename:=ExcelFilename
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
I was able to fix this using the below code.
Sub ExcelUpdater()
FileSharepointLocation = Range("FileLocation").Value
ExcelFilename = "Destination File.xlsb"
FileAddress = FileSharepointLocation + "/" + ExcelFilename
If Workbooks.CanCheckOut(FileAddress) = True Then
Workbooks.Open Filename:=FileAddress
Workbooks.CheckOut FileAddress
Else
MsgBox "Unable to check out this document at this time."
End If
Workbooks(ExcelFilename).CheckIn SaveChanges:=True,Comments:="Changes in..."
End Sub

Can't find project or library crashes everything

I have a number of Excel files that refresh themselves via macro, and a master file to control opening the other. The master file has an Auto_Open macro that opens each doc, runs the macro in the doc, then closes it. Each doc's macro essentially refreshes all the queries inside and saves the doc in two different places. To top it all of, I am using Window's Task Scheduler to open the master doc every two hours, kicking off the whole process.
This generally works pretty well. However, I will occasionally get an error for one the docs that says "Cannot find project or library." This occurs seemingly at random and with a different doc each time (though never the master doc). Once this error appears, Excel will crash completely every time I try to open the VBA window. The macro in said doc will no longer run via the master file's Auto_Open macro, and I have to recreate said doc from scratch.
I have tried to find the library as suggested by Microsoft (https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/can-t-find-project-or-library) but to no avail. Opening the VBA window in the affected file causes an immediate crash, and following the steps in the article above for an unaffected file reveals nothing wrong. The crash returns this error text:
Problem signature:
Problem Event Name: APPCRASH
Application Name: EXCEL.EXE
Application Version: 16.0.11231.20130
Application Timestamp: 5c518be9
Fault Module Name: VBE7.DLL
Fault Module Version: 0.0.0.0
Fault Module Timestamp: 5c064824
Exception Code: c0000005
Exception Offset: 00000000000b555a
OS Version: 6.3.9600.2.0.0.272.7
Locale ID: 1033
Code in Master File:
Sub Auto_Open()
Application.Wait (Now + TimeValue("0:00:10"))
Application.Calculation = xlCalculationManual
Workbooks.Open ("C:\Users\aowens\Desktop\Queries\ATSReports\ATSReports.xlsm")
Application.Run "'C:\Users\aowens\Desktop\Queries\ATSReports\ATSReports.xlsm'!Macro"
Workbooks("ATSReports.xlsm").Close False
Workbooks.Open ("C:\Users\aowens\Desktop\Queries\MiscLookups\MiscLookups.xlsm")
Application.Run "'C:\Users\aowens\Desktop\Queries\MiscLookups\MiscLookups.xlsm'!Macro"
Workbooks("MiscLookups.xlsm").Close False
(this pattern repeats for 5 other files)
Sample macro within one the files:
Sub Macro()
Dim errorcount
Dim broken
Dim this As Date
this = now()
errorcount = 0
On Error Resume Next
ThisWorkbook.Connections("Query - MasterROCL").Refresh
If Err <> 0 Then
errorcount = errorcount + 1
broken = broken & " ROCL"
End If
Err = 0
ThisWorkbook.Connections("Query - MasterRMEL").Refresh
If Err <> 0 Then
errorcount = errorcount + 1
broken = broken & " RMEL"
End If
Err = 0
ThisWorkbook.Connections("Query - MasterRHIL").Refresh
If Err <> 0 Then
errorcount = errorcount + 1
broken = broken & " RHIL"
End If
Err = 0
ThisWorkbook.Connections("Query - MasterREXH").Refresh
If Err <> 0 Then
errorcount = errorcount + 1
broken = broken & " REXH"
End If
Err = 0
Calculate
ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.SaveAs ("R:\Operations\Dashboards\Queries\ATSReports.xlsm")
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "aowens#explorenetwork.org"
.Subject = errorcount & " Errors for " & Format(now(), "MM/DD HH:MM") & " ATS Refresh"
.htmlBody = " ~ " & Round(1440 * (TimeValue(now()) - TimeValue(this)), 0) & " mins. Broken:" & broken
.Send
End With
End Sub
I often run into the same error as you under similar circumstances. I can't tell you what causes the error or how to stop it but i can help with this
"and I have to recreate said doc from scratch."
To recover the file you need to open the file in Excel's safe mode (hold ctrl and open Excel to activate Safe Mode) then open VBE > Debug > Compile Project. Then save and close, next time you open the file it should be fine.

Task Schedule Open Excel file, Refresh Bloomberg Data, then Save and Close File

I have tried to collect all codes I could have done and it still not work for me.
What I want to do is to Schedule Task of my Excel file and I have code "RunExcel.vbs" as attached but still not working.
Reference Link: How to set recurring schedule for xlsm file using Windows Task Scheduler
Reference Link: https://www.mrexcel.com/forum/excel-questions/794869-vb-script-refresh-bloomberg-feed-excel.html
Open file “PriceRealTIme.xlsm”(Macro-enabled workbook) which is inside “TEst folder”.
Ignore to update link
Let it “Refresh Bloomberg Data” and “wait for at 1 minutes or until it done refreshing”.
Once it’s done. I want to copy paste Value of those columns by using Macro named “CopyPaste”.
Finally, let it “Save” and “Close” file.
' a .vbs file is just a text file containing visual basic code that has the extension renamed from .txt to .vbs
'Write Excel.xls Sheet's full path here
strPath = "C:\Users\chaic\OneDrive\Desktop\TEst\PriceRealTIme.xlsm"
'Write the macro name - could try including module name
strMacro = "Sheet1.CopyPaste"
'Create an Excel instance and set visibility of the instance
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True ' or False
'Open workbook; Run Bloomberg Addin; Run Macro; Save Workbook with changes; Close; Quit Excel
Set wbToRun = objApp.Workbooks.Open(strPath)
Private Const BRG_ADDIN As String = "BloombergUI.xla"
Private Const BRG_REFRESH As String = "!RefreshAllStaticData"
Private TimePassed As Integer
Sub StartAutomation()
Dim oAddin As Workbook
On Error Resume Next
Set oAddin = Workbooks(BRG_ADDIN)
On Error GoTo 0
If Not oAddin Is Nothing Then
Application.Run BRG_ADDIN & BRG_REFRESH
StartTimer
End If
End Sub
Private Sub StartTimer()
TimePassed = 10
WaitTillUpdateComplete
End Sub
Sub WaitTillUpdateComplete()
If WorksheetFunction.CountIf(ThisWorkbook.Names("BloombergDataRange").RefersToRange,"#VALUE!") = 0 Then
Application.StatusBar = "Data update used " & TimePassed & "seconds, automation started at " & Now
Else
Application.StatusBar = "Waiting for Bloomberg Data to finish updating (" & TimePassed & " seconds)..."
TimePassed = TimePassed + 1
Application.OnTime Now + TimeSerial(0, 0, 1), "WaitTillUpdateComplete"
End If
End Sub
objApp.Run strMacro ' wbToRun.Name & "!" & strMacro
wbToRun.Save
wbToRun.Close
objApp.Quit
'Leaves an onscreen message!
MsgBox strPath & " " & strMacro & " macro and .vbs successfully completed!", vbInformation
This is an old threat, but maybe this answer will help others.
The code below is working for me. The computer is set for it to never sleep or lock the screen.
The computer is using Office 365 and excel 2016.
' a .vbs file is just a text file containing visual basic code that has the extension renamed from .txt to .vbs
'Write Excel.xls Sheet's full path here
strPath = "myPath"
'Create an Excel instance and set visibility of the instance
Set objApp = CreateObject("Excel.Application")
objApp.Visible = False ' or True
Set wbToRun = objApp.Workbooks.Open(strPath)
StartAutomation
Sub StartAutomation()
Dim oAddin
Set oAddin = objApp.Workbooks.Open("C:\blp\API\Office Tools\BloombergUI.xla")
objApp.Addins("Bloomberg Excel Tools").Installed = False
objApp.Addins("Bloomberg Excel Tools").Installed = True
If Not oAddin Is Nothing Then
objApp.DisplayAlerts = False
objApp.Calculate
objApp.Run "RefreshAllStaticData"
objApp.Calculate
objApp.Run "RefreshAllStaticData"
WaitTillUpdateComplete
End If
End Sub
Dim t
t = 0
Private Sub WaitTillUpdateComplete()
objApp.Calculate
If objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#NAME?") > 0 Then
Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A") > 0 Then
Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A Requesting Data...") > 0 Then
If t < 5 Then
t = t+ 1
waitlonger
Else
Exit Sub
End If
Else
Exit Sub
End If
End Sub
Sub waitlonger()
Dim x
x = Now + TimeValue("00:00:40")
Do While x > Now
Loop
objApp.Calculate
End Sub
wbToRun.Save
wbToRun.Close
objApp.DisplayAlerts = False
objApp.Quit

Resources