agentkramr
Board Regular
- Joined
- Dec 27, 2021
- Messages
- 98
- Platform
- Windows
i have posted here before and received some help have tried some different approaches and still cant solve this. i know it is doable but for some reason just one portion isnt functioning correctly. i have a vbs that fires to open a spreadsheet and closes it when the VBA is done (this functions correctly)
the VBA creates an email attaches a screen shot to the body of an email attaches a xlsx version of the workbook to the email instead of the original version xlsm (this works) the only thing is the screen shot and attached workbook dont have the refreshed numbers its like it doesnt wait for the background queries to finish before it takes the screenshot and attaches a copy. It all connects to a Oracle database to collect some figures.
Any help is greatly appreciated
the VBA creates an email attaches a screen shot to the body of an email attaches a xlsx version of the workbook to the email instead of the original version xlsm (this works) the only thing is the screen shot and attached workbook dont have the refreshed numbers its like it doesnt wait for the background queries to finish before it takes the screenshot and attaches a copy. It all connects to a Oracle database to collect some figures.
Any help is greatly appreciated
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
'Save Workbook
ThisWorkbook.Save
'************************************************* ********
'Set email details; Comment out if not required
Const MailTo = "test@test.com"
'Const MailCC = "[EMAIL]some2@someone.com[/EMAIL]"
'Const MailBCC = "[EMAIL]some3@someone.com[/EMAIL]"
MailSub = "Test"
MailTxt = ""
'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:S50"))
'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:S50").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
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
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
