add to VBA to wait for background queries to finish before starting

agentkramr

Board Regular
Joined
Dec 27, 2021
Messages
98
Platform
  1. Windows
Could someone please help me add to my code ?
i need for this vba to wait until background queries are finished before running
VBA Code:
Sub Test_Hourly()
Dim oApp As Object, oMail As Object, FileStr As String
Dim NewWb As Workbook, cnt As Integer
Dim FileName As String, MailSub As String, MailTxt As String
Dim tmpImageName As String
'************************************************* ********
'Set email details; Comment out if not required
Const MailTo = "my email"
Const MailCC = "some2@someone.com"
Const MailBCC = "some3@someone.com"
MailSub = "test"
MailTxt = "test"

'Turns off screen updating
Application.ScreenUpdating = False
Sheets("1 Hour Counts").Unprotect "Test"
'define a temp path for your image
tmpImageName = Environ$("temp") & "" & "TempChart.jpg"
'create image file
Call CreateJpg("1 Hour Counts", Sheets("1 Hour Counts").Range("A1:S30"))
'copy range to new wb/remove formulas
Set NewWb = Workbooks.Add
'copy all sheets
For cnt = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(cnt).Copy NewWb.Sheets(cnt)
Next cnt
NewWb.Sheets("1 Hour Counts").Range("A1:S30").Copy
NewWb.Worksheets("1 Hour Counts").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'NewWb.Worksheets("1 Hour Counts").Shapes("Rectangle: Rounded Corners 1").Delete
'NewWb.Worksheets("1 Hour Counts").Shapes("Rectangle: Rounded Corners 2").Delete
NewWb.Worksheets("1 Hour Counts").Activate
NewWb.Worksheets("1 Hour Counts").Range("A1").Select
Application.DisplayAlerts = False
NewWb.Worksheets("Sheet1").Delete
NewWb.SaveAs FileName:=Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 5) & ".xlsx", _
                                                        FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
FileStr = NewWb.FullName
NewWb.Close
Sheets("1 Hour Counts").Protect "Test"

'Creates and shows the outlook mail item

Set oApp = CreateObject("Outlook.Application")

Set oMail = oApp.CreateItem(0)

With oMail

.To = MailTo

.Cc = MailCC

.Bcc = MailBCC

.Subject = MailSub

.HTMLBody = "<body><img src=" & "'" & tmpImageName & "'/></body>"

.Attachments.Add FileStr

.Display

.Send

End With

'Deletes the temporary file

'WB.ChangeFileAccess Mode:=xlReadOnly

Kill (Environ$("temp") & "" & "TempChart.jpg")

Kill FileStr


'Restores screen updating and release Outlook

Application.ScreenUpdating = True

Set oMail = Nothing

Set oApp = Nothing

'Save Workbook

'ThisWorkbook.Save

End Sub

Public Sub CreateJpg(SheetName As String, xRgAddrss As Range)
'creates temp JPG file of range (xRgAddrss) by creating temp chart
'uses current wb sheet (sheetname) to locate temp chart
Dim xRgPic As Range
Worksheets(SheetName).Activate
Set xRgPic = xRgAddrss
xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, _
                                                          xRgPic.Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"
End With
Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
i suppose your problem is mostly in "CreateJpg".
I start with adding "Doevents"every 2nd line in that macro,
VBA Code:
xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
doevents
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, _
                                                          xRgPic.Width, xRgPic.Height)
doevents
.Activate
doevents
.Chart.Paste
doevents
.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"
doevents
End With
 
Upvote 0
i suppose your problem is mostly in "CreateJpg".
I start with adding "Doevents"every 2nd line in that macro,
VBA Code:
xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
doevents
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, _
                                                          xRgPic.Width, xRgPic.Height)
doevents
.Activate
doevents
.Chart.Paste
doevents
.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"
doevents
End With
It still looks like it isnt finishing the background query before taking a screenshot and attaching a copy of the workbook
 
Upvote 0
wait a while just next line after that point, i hope that the refresh continues
VBA Code:
Application.Wait (Now + TimeSerial(0, 0, 3))
 
Upvote 0
I don't see the refresh in this part of the macro !

you have the line where the macro stops (due to not refreshed in time)
Add that "Wait" 1 line earlier and repeat this step until okay.
Now, it's 3 seconds delay, later, you can make the delay smaller.
 
Upvote 0
I don't see the refresh in this part of the macro !

you have the line where the macro stops (due to not refreshed in time)
Add that "Wait" 1 line earlier and repeat this step until okay.
Now, it's 3 seconds delay, later, you can make the delay smaller.
the refresh happens when you open the workbook, it runs the background queries and all that. i dont think the macro is waiting for that refresh to finish before running. i use a VBS run on a task scheduler to make it all start to be completely automatic
 
Upvote 0
i was googling, but i can't try things out.
perhaps this link Wait until ActiveWorkbook.RefreshAll finishes - VBA
I saw something funny, save or saveas the workbook after you refreshed it, that can't be doen if the refreshment isn't finished. If you get an error there, add that wait-instruction there, perhaps in a loop with a check on ".Saved".
Just giving you suggestions ...
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top