Sub SendSSRSReportByEmail()
Dim strURL As String
Dim strSavePath As String
Dim strReportName As String
Dim strRecipientEmail As String
Dim strSenderEmail As String
Dim objOutlook As Object
Dim objMail As Object
Dim objShell As Object

' Set URL of the SSRS report
strURL = "http://yourssrsreportserver.com/ReportServer?/YourReportPath&rs:Format=MHTML"

' Set path to save the MHTML file
strSavePath = "C:Temp" ' Change this path to your desired location

' Set name for the downloaded report file
strReportName = "YourReportName.mhtml"

' Set recipient email address to send the report
strRecipientEmail = "[email protected]"

' Set sender email address
strSenderEmail = "[email protected]"

' Download the report as MHTML
Dim objXMLHTTP As Object
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", strURL, False
objXMLHTTP.send

If objXMLHTTP.Status = 200 Then
    Dim objFSO As Object
    Dim objFile As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(strSavePath & strReportName)
    objFile.Write objXMLHTTP.responseText
    objFile.Close
    
    ' Open the downloaded report in default browser (Edge)
    Set objShell = CreateObject("Shell.Application")
    objShell.Open strSavePath & strReportName
    
    ' Wait for the report to open
    Application.Wait Now + TimeValue("0:00:05") ' Adjust the waiting time as needed
    
    ' Copy the entire content of the report to clipboard
    Application.SendKeys "^a", True
    Application.SendKeys "^c", True
    
    ' Send the report via email using Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    With objMail
        .To = strRecipientEmail
        .Subject = "SSRS Report"
        .Display
        .HTMLBody = ""
        Application.Wait Now + TimeValue("0:00:01") ' Wait for the email window to fully open
        Application.SendKeys "^v", True ' Paste the content from clipboard into the email body
        .SentOnBehalfOfName = strSenderEmail
        '.Send ' Uncomment this line to send the email directly
    End With
    
    MsgBox "Report sent successfully.", vbInformation
Else
    MsgBox "Failed to download the report.", vbExclamation
End If

End Sub

Sub SendSSRSReportByEmail()
Dim objXMLHTTP As Object
Dim objADOStream As Object
Dim strURL As String
Dim strSavePath As String
Dim strReportName As String
Dim strEmail As String
Dim objOutlook As Object
Dim objMail As Object

' Set URL of the SSRS report
strURL = "http://yourssrsreportserver.com/ReportServer?/YourReportPath&rs:Format=MHTML"

' Set path to save the MHTML file
strSavePath = "C:Temp" ' Change this path to your desired location

' Set name for the downloaded report file
strReportName = "YourReportName.mhtml"

' Set email address to send the report
strEmail = "[email protected]"

' Download the report as MHTML
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", strURL, False
objXMLHTTP.send

If objXMLHTTP.Status = 200 Then
    Set objADOStream = CreateObject("ADODB.Stream")
    objADOStream.Open
    objADOStream.Type = 1 'Binary
    objADOStream.Write objXMLHTTP.ResponseBody
    objADOStream.Position = 0
    objADOStream.SaveToFile strSavePath & strReportName
    objADOStream.Close
Else
    MsgBox "Failed to download the report.", vbExclamation
    Exit Sub
End If

' Send the report via email using Outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
    .To = strEmail
    .Subject = "SSRS Report"
    .Body = "Please find the attached SSRS report."
    .Attachments.Add strSavePath & strReportName
    .Send
End With

MsgBox "Report sent successfully.", vbInformation

End Sub