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
Related
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
I have a Query linked to an Excel spreadsheet. I want that the users can refresh the query and run VBA code once they click on a Refresh button.
Sometimes users do not have the access to the source data, so the query does not update properly. When they click on the refresh button it does not show any error message and continues to run the code without updating the query.
Is there any process to show the status that the query did not download the data?
for error control you can use this:
Public Function example()
On Error GoTo Err_Control
' you code
Err_Control:
If Err.Number <> 0 Then
If Err.Number = 1004 Then
MsgBox "You do not have permission to access the data source." & Chr(13) & "Macro will be finished."
Exit Function
Else
MsgBox Err.Number & " - " & Err.Description
End If
End If
End Function
Iinside Err_Control you put the error handler.
First time post but a long time user! Firstly I wanted to say thank you to every for all the code feedback you guys put on posts. It's helped me develop my VBA code more than you can imagine!
Ok so the question:
Background:
I'm developing a VBA focused addin for myself and colleagues to use. Part of this is include functions that you would except in Excel but aren't there. Some of these were quite easy to do (ie invert filters) but some are proving more difficult. This is one of those examples.
Issue:
The following code is meant to loop through the users selection of sheets, apply a user defined password or remove the existing one. Part of the function is to capture passwords that can't be removed (ie becuase the user entered an incorrect password). It works great for the first error occurrence but throughs up the runtime error (1004) for the second and repeating ones after. I don't much much experience with runtime errors handling (try to avoid errors!) but I can't get this to work. Any ideas /help to stop the runtime error popping up would be great.
Code:
Dim SHT As Worksheet, Password As String, SHT_Names(0 To 30) As String
'PREP
'DISABLE APPLICATION FUNCTIONS
Call Quicker_VBA(False)
Application.EnableEvents = False
'USER PASSWORD OPTION
Password = InputBox("Please enter a password (leave blank for no password)", "Password")
'USER INFORMATION MESSAGES SETUP
MSG_Protect = "Added to-"
Protect_check = MSG_Protect
MSG_Unprotect = "Removed from-"
Unprotect_check = MSG_Unprotect
MSG_unable = "Unable to remove protection from-"
Unable_check = MSG_unable
'ID SHEETS SELECTED
For Each SHT In ActiveWindow.SelectedSheets
a = a + 1
SHT.Activate
SHT_Names(a) = SHT.name
Next
'MAIN
HomeSHT = ActiveSheet.name
'PROTECT SHEETS SELECTED BY USER
For b = 1 To a
Sheets(SHT_Names(b)).Select
Set SHT = ActiveSheet
'ENABLE OR REMOVE PROTECTION FROM SELECTED SHEET
If SHT.ProtectContents Then
On Error GoTo Password_FAIL
Application.DisplayAlerts = False
SHT.Unprotect Password
On Error GoTo 0
MSG_Unprotect = MSG_Unprotect & vbNewLine & Chr(149) & " " & SHT.name
Else:
'ENABLE FILTER CHECK
FilterOn = False
If ActiveSheet.AutoFilterMode Then FilterOn = True
'PROTECT SHEET
SHT.Protect Password, AllowFiltering:=FilterOn
'UPDATE USER MESSAGE
MSG_Protect = MSG_Protect & vbNewLine & Chr(149) & " " & SHT.name & " - Users can: Select locked and unlocked cells"
If FilterOn = True Then MSG_Protect = MSG_Protect & " and use filters"
End If
200 Next
'INFORM USER
If Protect_check <> MSG_Protect Then msg = MSG_Protect & vbNewLine & "___________________" & vbNewLine
If Unprotect_check <> MSG_Unprotect Then msg = msg & MSG_Unprotect & vbNewLine & "___________________" & vbNewLine
If Unable_check <> MSG_unable Then msg = msg & MSG_unable
MsgBox msg, , "Protection summary"
'TIDY UP
Sheets(HomeSHT).Activate
'ENABLE APPLICATION FUNCTIONS
Call Quicker_VBA(True)
Exit Sub
Password_FAIL:
MSG_unable = MSG_unable & vbNewLine & Chr(149) & " " & SHT.name
Application.EnableEvents = False
GoTo 200
End Sub
At a quick glance, it seems that the problem is in the way you're handling your errors. You use the line On Error GoTo Password_FAIL to jump down to the error handler. The error handler logs some information and then jumps up to label '200'. I can't tell if the formatting is off, but it looks like the label for '200' points to Next, indicating that the loop should continue with the next sheet.
So, where's the problem? You never actually reset the original error. Three lines below On Error GoTo Password_FAIL you explicitly call On Error GoTo 0 to reset the error handler, but that line will never actually be reached in an error. The program will jump to the error handler, and then from there jump up to the loop iterator. Using the GoTo statement for control flow can easily lead to these types of issues, which is why most developers recommend against it.
I'll post some sample code below to show a different (potentially better) way to handle code exceptions. In the sample below, the code simply loops through all of the worksheets in the workbook and toggles the protection. I didn't include much of your logging, or the constraint that only the selected sheets be toggled. I wanted to focus on the error handling instead. Besides, from reading you code, it seems that you can manage more of the peripheral details. Send a message if there's still some confusion
Sub ToggleProtectionAllSheets()
Dim sht As Worksheet
Dim password As String
On Error Resume Next
password = InputBox("Please enter a password (leave blank for no password)", "Password")
For Each sht In ActiveWorkbook.Worksheets
If sht.ProtectContents Then
sht.Unprotect password
If Err.Number <> 0 Then
Err.Clear
MsgBox "Something did not work according to plan unprotecting the sheet"
End If
Else
sht.Protect password
If Err.Number <> 0 Then
Err.Clear
MsgBox "Something went wrong with protection"
End If
End If
Next sht
End Sub
I'm trying to combine user inputs with existing Excel file data so they will all be included in a single table when they are uploaded to the Access database.
Here is the way I have it laid out, but I'm open to changing it however need be.
I'm just completely stuck with what to do next. Upload Date is automatically filled in, but the rest of the parameters will vary based on the product and will have to be filled in manually. I also want it to be mandatory that every field is filled in, so have an error message saying "Enter all parameters" or something like that if they aren't, which wouldn't allow the upload to be completed.
The reason why this is necessary to do in Access and simply not Excel is because the Excel file is generated by AutoCad Electrical and is limited in what data it can include. I tried adding the columns in Excel and importing them and it worked, but my boss said we NEED the user input box to make things easier.
This is the code I have to import the Excel file and add it to the correct table (_MCL UPLOAD). Now I just want to be able to have the user inputs add to this table as extra columns:
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
'load spreadsheet
DoCmd.TransferSpreadsheet acImport, 8, "_MCL UPLOAD", selectFile(), True
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
Function selectFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show Then
selectFile = .SelectedItems(1)
Else
'stop execution if nothing selected
End
End If
End With
Set fd = Nothing
End Function
My final code looks like this:
'Import MCL Files Code
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
'load spreadsheet in .xls format
DoCmd.TransferSpreadsheet acImport, 8, "_MCL_UPLOAD", selectFile(), True
DoCmd.OpenQuery "UpdateMCL"
Call InsertInto_MASTER_UPLOAD
Call Delete_MCL_UPLOAD
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
'Function called in Import MCL Code above
Function selectFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show Then
selectFile = .SelectedItems(1)
Else
'stop execution if nothing selected
End
End If
End With
Set fd = Nothing
End Function
'Function Used to Delete MCL Uploaded file after it's moved to Master Table
Sub Delete_MCL_UPLOAD()
Dim dbs As Database, rst As Recordset
' Modify this line to include the path to Northwind
' on your computer.
Set dbs = OpenDatabase("default_cat.mdb")
' Delete employee records where title is Trainee.
dbs.Execute "DELETE * FROM " _
& "_MCL_UPLOAD "
dbs.Close
End Sub
'Function Appends _MCL UPLOAD into the _MASTER_UPLOAD table
Sub InsertInto_MASTER_UPLOAD()
Dim dbs As Database
' Modify this line to include the path to Northwind
' on your computer.
Set dbs = OpenDatabase("default_cat.mdb")
' Select all records in the New Customers table
' and add them to the Customers table.
dbs.Execute " INSERT INTO _MASTER_UPLOAD " _
& "SELECT * " _
& "FROM [_MCL_UPLOAD];"
dbs.Close
End Sub
I basically created another table to dump all of the combined information into. Thanks for all of your help!
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.