Hi all, Sorry this seems long, but I've learned it's best to provide as much info as possible right out of the gate on this forum
I've got this macro that seems to work just fine when i execute it one line at a time or in small blocks, but when I run the whole thing at once it gives me errors, which my error handling attempts don't seem to respond to as I'd hoped, and I have no idea why... it seems like maybe it's just running through the code too fast?
The problems are mainly with a function called by the main procedure that refreshes a power query in another workbook before performing an action on the query's results... the reason that the queries are in a separate workbook is that this needs to be a shared document, so no tables allowed...
Is it possible that the query is taking too long? or that maybe the network connection to the server isn't fast enough? or is there something in my code or missing from it that is the cause?
so from the main procedure I call the refresh function with this line,
Call Refresh_Query(myTable, SourceWb, ws)
Here is the code for the function, I've put my comments right in with the code...
The code for the main Sub is as follows...
I'm still relatively inexperienced at this so I would not be surprised if there are multiple errors, omissions or other defects with my code, but I would really, really, really appreciate any advice!
Thanks in advance!
I've got this macro that seems to work just fine when i execute it one line at a time or in small blocks, but when I run the whole thing at once it gives me errors, which my error handling attempts don't seem to respond to as I'd hoped, and I have no idea why... it seems like maybe it's just running through the code too fast?
The problems are mainly with a function called by the main procedure that refreshes a power query in another workbook before performing an action on the query's results... the reason that the queries are in a separate workbook is that this needs to be a shared document, so no tables allowed...
Is it possible that the query is taking too long? or that maybe the network connection to the server isn't fast enough? or is there something in my code or missing from it that is the cause?
so from the main procedure I call the refresh function with this line,
Call Refresh_Query(myTable, SourceWb, ws)
Here is the code for the function, I've put my comments right in with the code...
Code:
Function Refresh_Query(myTable As ListObject, SourceWb As Workbook, ws As Worksheet)
DisplayAlerts = True '---- I am trying to activate the source sheet and display the query window so that can see a bit of how the refresh is progressing
SourceWb.Activate
ws.Activate '----- Often I will get a run-time error '91' on this line, Object variable or With block variable not
set as though nothing was passed from the main sub for the ws variable. This does not happen when stepping through
manually, and when stepping through manually, ?ws.name will display the name of the ws correctly in the immediate window.---'
On Error GoTo Vis '---- This was an attempt to handle an error consistently thrown on the following line, it seemed
that the code was just going too fast and that re-running the .Visible = True command would remedy the issue and
display the commandbar as expected. However, it doesn't seem to handle the error as expected in that it just throws
up the debugger error box, rather than jumping up to vis: and rerunning the line.---'
Vis: '---Error handling meant to just repeat command below
Application.CommandBars("Workbook Queries").Visible = True '---- Often i get Run-Time error 2147467259 (80004005)'
Method 'Visible' of object 'CommandBar' failed. Sometimes I get Run-Time error '5': Invalid procedure call or argument,
but neither when stepping through manually...---'
On Error GoTo 0
'----The next few lines are fine------'
Application.CommandBars("Workbook Queries").Width = 300
On Error GoTo 0
'Get current background-refresh value
bBackground = myTable.QueryTable.BackgroundQuery
'Temporarily disable background-refresh
myTable.QueryTable.BackgroundQuery = False
'------- This next bit refreshes the query, but seems to throw an error more often than not, which seems like a 'timeout'
problem or a network speed issue... not sure if that's accurate, just an impression. Visually, the query seems to load
the data into the table, but the actual process doesn't seem to complete; so even though the refreshed data is visible
and appears complete, the status of the query still displays "loading..." with the little spinning wheel. Eventually I'll
get the HRESULT: 0x800A03EC error, which triggers the error handling line at the bottom.---------'
'Refresh this connection
On Error GoTo err
myTable.QueryTable.Refresh
'Set background-refresh value back to original value
myTable.QueryTable.BackgroundQuery = bBackground
Application.CommandBars("Workbook Queries").Visible = False
err:
MsgBox "The search could not be completed." & vbCrLf & "Please try again later.", vbOKOnly, "Error"
End Function
The code for the main Sub is as follows...
Code:
Sub Add_New_Records_Click()
'
' Update_Button Macro
'
Dim myTable As ListObject
Dim DestWb, SourceWb As Workbook
Dim ws As Worksheet
Dim strFilename As String: strFilename = "\\my file path...."
Dim LRow, CountNew As Long
Dim Result As Integer
'Option to exit
Result = MsgBox("This will take several minutes..." & vbCrLf & "Press Ok to continue and go for coffee :)", vbOKCancel)
If Result = vbCancel Then Exit Sub
'Set path for Table Variable
Set DestWb = ThisWorkbook
On Error Resume Next
' Test to see if the file is open.
If IsFileOpen(strFilename) = False Then
Set SourceWb = Workbooks.Open(strFilename)
Else
Set SourceWb = Workbooks("caselog with listing.xlsm")
Set ws = Sheets("New Records")
SourceWb.Save
End If
DestWb.Activate
On Error Resume Next
With Sheets("CaseLog")
.ShowAllData
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
On Error GoTo 0
DestWb.Save
SourceWb.Activate
Set myTable = SourceWb.Worksheets("New Records").ListObjects("NewRecords")
Call Refresh_Query(myTable, SourceWb, ws)
On Error GoTo err
CountNew = myTable.ListRows.Count
If CountNew = 0 Then
MsgBox "No New Records Found", vbOKOnly, "Add New Records?"
GoTo fin
Else
Result = MsgBox(CountNew & " New Records Found. Click OK to Add.", vbOKCancel, "Add New Records?")
If Result = vbCancel Then Exit Sub
End If
myTable.DataBodyRange.Copy
DestWb.Activate
With Sheets("CaseLog")
Range("C" & LRow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A" & LRow & ":" & "B" & LRow + CountNew).FillDown
End With
GoTo fin
err:
MsgBox "The search could not be completed." & vbCrLf & "Please try again later.", vbOKOnly, "Error"
fin:
SourceWb.Close SaveChanges:=True
End Sub
I'm still relatively inexperienced at this so I would not be surprised if there are multiple errors, omissions or other defects with my code, but I would really, really, really appreciate any advice!
Thanks in advance!