Thursday, March 23, 2017

How to Send a Range from an Active Sheet in an Outlook Email Body from Active Workbook with VBA

VBA Macro to Send a Range from an Active Sheet in an Outlook Email Body from Active Workbook
Sub Mail_Selection_Range_Outlook_Body()
    Dim Rng As Range
    Dim OutlookApp As Object
    Dim NewMail As Object

    Set Rng = Nothing
    On Error Resume Next

    Set Rng = ActiveSheet.Range("MyRng")
'--You can also use a Fixed range if you want
    'Set Rng = Sheets("YourSheet").Range("A1:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Rng Is Nothing Then
        MsgBox "The Selection is not a Range or the Sheet is Protected" & _
               vbNewLine & "Please Correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutlookApp = CreateObject("Outlook.Application")
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    'Set NewMail = OutlookApp.CreateItem(0)
    
 '--Inserting Signature in Email Body
 '--Change only 'YourSignature.htm' to the name of your Signature
    SigString = Environ("appdata") & "\Microsoft\Signatures\Tamatam.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

 '--Selecting your desired Email Account for Sending From
 '--If the account is not in your profile, Then you need to use SentOnBehalfOfName
        For I = 1 To OutlookApp.Session.Accounts.Count
            If OutlookApp.Session.Accounts.Item(I) = "MyEmailAccountAlias@Domain.Com" Then
             MsgBox OutlookApp.Session.Accounts.Item(I) & " : This is account number " & I
                Acn_No = I
                Exit For
            End If
        Next I

'--Defining the Email Body Message
        Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
                    "This is sample test mail by Macro<br>" & _
                    "Please donot repond to it<br>" & _
                    "<A href=""https://excelkingdom.blogspot.in/"">Excel Kingdom</A>"
              
    On Error Resume Next

'--Opening a New Email to Send
    With NewMail
        .TO= "YourEmail@Domain.com" '--Your Email Id here
        .CC = ""
        .BCC = ""
        .Subject = "Test Message" '--Your Email Subject here
       '.Body = "This Your Email Boday ; '--You can use below one as well
        .HTMLBody = Strbody & "<br>" & "<br>" & _
                    RangetoHTML(Rng) & "<br>" & "<br>" & _
                    "<B>Thank you</B>" & "<br>" & "<br>" & Signature
        .SentOnBehalfOfName = OutlookApp.Session.Accounts.Item(Acn_No) 
        '--You can use below one as well
        '.SentOnBehalfOfName = "MyEmailAccountAlias@Domain.Com"
        '.SendUsingAccount = OutlookApp.Session.Accounts.Item(Acn_No)
        .Display '--Use .Display to show you the Email before sending it.
        .Send
    End With
    
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

-- This is will call to above Procedure to Copy the Range from Active sheet to a .htm file then to the Email Message Body

Function RangetoHTML(Rng As Range)
    Dim FSO As Object
    Dim TS As Object
    Dim TempFile As String
    Dim TempWB As Workbook

'--Creating a Temporary .htm file to Copy the Range from Active sheet.
    'TempFile = Environ$("temp") & "\" & Format(Now, "dd-mmm-yyyy") & ".htm"
     TempFile = Environ("UserProfile") & "\Desktop\Test\" & Format(Now, "dd-mmm-yyyy") 
                                                                                                 & ".htm"

 '--Copy the range and Paste the data to newly created Workbook
    'Rng.Select
    Rng.Copy
    Set TempWB = Workbooks.Add(xlWBATWorksheet)

'--Copy Pasting the Range from  Active Sheet to a Temp Workbook Sheet
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8 'Paste with same Column Widths
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

'--Publish the Sheet to a htm file from Temp Workbook Sheet
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

 '--Reading all data from the htm file into RangetoHTML variable
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = TS.readall
    TS.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

'--Closing the TempWB
    TempWB.Close SaveChanges:=False

'--Delete the htm file we used in this Function
    Kill TempFile

    Set TS = Nothing
    Set FSO = Nothing
    Set TempWB = Nothing
End Function

-- This is will call to above Procedure to Copy the Signature to the Email Message Body
Function GetBoiler(ByVal SigFile As String) As String
    Dim FSO As Object
    Dim TS As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.GetFile(SigFile).OpenAsTextStream(1, -2)
    GetBoiler = TS.readall
    TS.Close

End Function
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

How to Send Active Sheet as an Outlook Email Attachment with VBA

VBA Macro to Send Active Sheet as an Outlook Email Attachment from Active Workbook
The following Macro will copy the Active sheet data from the This/Active Workbook to a New Workbook with single sheet and Save that with Active sheet name, then it will send via Outlook as an Email Attachment, from a specified Email Account/Alias to the defined Users.
Sub Email_ActiveSheet_WB()
    Dim OutlookApp As Object
    Dim NewMail As Object
    Dim ActShtName As String
    Dim FileFullPath As String
       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

'Copying the Active Sheet data
    ActiveSheet.Cells.Copy
    ActShtName = ActiveSheet.Name
  
  'Saving the Active sheet data  into a new workbook with Active Sheet name_Today date
    Workbooks.Add (xlWBATWorksheet)
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
    ActiveSheet.Name = ActShtName

    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\Test\" & ActShtName & "_" &                                                                Format(Now, "dd-mmm-yyyy") & ".xlsx"

'Storing the Saved file(which we used for attachment later) path into a Variable
    FileFullPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

    ActiveWorkbook.Close True

    Application.DisplayAlerts = True
  
'Setting up the objects of Outlook Application and New Email 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    'Set NewMail = OutlookApp.CreateItem(0)

'Inserting Signature in Email Boday ; Change only 'YourSignature.htm' to the name of your Signature
    SigString = Environ("appdata") & "\Microsoft\Signatures\Tamatam.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

'Selecting your desired Email Account for Sending From Account
'If the account is not in your profile, Then you need to use SentOnBehalfOfName

        For I = 1 To OutlookApp.Session.Accounts.Count
          If OutlookApp.Session.Accounts.Item(I) = "MyEmailAccountAlias@Domain.Com"                   Then
        '--MsgBox OutlookApp.Session.Accounts.Item(I) & " : This is account number " & I
                Acn_No = I
                Exit For
           End If
        Next I

'Defining the Email Body Message
        Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
                    "This is Sample Test Email by Macro<br>" & _
                    "Please donot repond to It<br>" & _
                    "<A href=""https://excelkingdom.blogspot.in/"">Excel Kingdom</A>"
              
    On Error Resume Next

'Opening a New Email to Send

    With NewMail
        .TO = "YourEmail@Domain.com" 'Your Email Id here
        .CC = ""
        .BCC = ""
        .Subject = "Test Message" 'Your Email Subject here
       '.Body = "This Your Email Boday ; '--You can use below one as well
        .HTMLBody = Strbody & "<br>" & "<br>" & "<B>Thank you</B>" & "<br>" & Signature
        .Attachments.Add FileFullPath '-- Full Path of the Attachment where it is saved.
        .SentOnBehalfOfName = OutlookApp.Session.Accounts.Item(Acn_No) 
          '--You can use below one as well
        '.SentOnBehalfOfName = "MyEmailAccountAlias@Domain.Com"
        '.SendUsingAccount = OutlookApp.Session.Accounts.Item(Acn_No)
        .Display '--Use .Display to show you the Email before sending it.
        .Send
    End With
    
    On Error GoTo ErrMsg:    
' Since mail has been sent with the attachment.You can kill the Source file if not required    
    Kill FileFullPath
    
' Set nothing to the objects created.
    Set NewMail = Nothing
    Set OutlookApp = Nothing
    
' Now set the application properties back to true.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "Activesheet as Email Attchment Sent Successfully", vbOKOnly, "Job Done"
    Exit Sub

ErrMsg:
        MsgBox Err.Description

End Sub

'The Function to Look and Get the Email Signature; Calls into above Macro
   Function GetBoiler(ByVal SigFile As String) As String
      Dim FSO As Object
      Dim TS As Object
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set TS = FSO.GetFile(SigFile).OpenAsTextStream(1, -2)
      GetBoiler = TS.readall
      TS.Close

   End Function
---------------------------------------------------------------------------------------------------------------------
Note : Please note that You have to define both the Sub Procedure and Function in the same Module, to call Signature into your Email body.
---------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Wednesday, March 22, 2017

How to Pivot the Data in SQL Server

SQL Server Pivot Operator Syntax with Examples
The Pivoting is an operation that transforms the data from rows to a state of columns to pivot the data used for different reporting needs to summarize and analyze the data. The Pivot helps to you fit the certain amount of data in less space.It helps to analyze the data presented as the intersection of dimensions represented by rows and columns. 
Syntax:
SELECT <col-list>
FROM <source> PIVOT (<aggre-func>(<aggre-col>)
FOR <spreading-col> IN (<spreading-col-elements>)) as PVT

Example :
USE [TAMATAM]
GO
SELECT [Sales_Region] ,[Sales_Period],[Cust_Segment],[NetSales]
  FROM [dbo].[SalesTable]
GO
Sample Source Data used for Pivot Operation :
Sales_Region Sales_Period Cust_Segment NetSales
East 201501 Automobile 7276
East 201502 Electronics 2402
East 201503 Pharma 7097
East 201504 Construction 6521
East 201505 Banking 9966
East 201506 Energy 2917
East 201507 Automobile 5220
East 201508 Electronics 6304
East 201509 Pharma 4060
East 201510 Construction 7098
East 201511 Banking 5688
East 201512 Energy 4433
West 201501 Automobile 7627
West 201502 Electronics 2340
West 201503 Pharma 3530
West 201504 Construction 5594
West 201505 Banking 8356
West 201506 Energy 7172
West 201507 Automobile 2546
West 201508 Electronics 5645
West 201509 Pharma 9049
West 201510 Construction 5443
West 201511 Banking 7313
West 201512 Energy 6694
South 201501 Automobile 5573
South 201502 Electronics 7319
South 201503 Pharma 7628
South 201504 Construction 5158
South 201505 Banking 8457
South 201506 Energy 9548
South 201507 Automobile 7640
South 201508 Electronics 2481
South 201509 Pharma 2300
South 201510 Construction 3198
South 201511 Banking 8492
South 201512 Energy 5331
North 201501 Automobile 7862
North 201502 Electronics 3915
North 201503 Pharma 1977
North 201504 Construction 9125
North 201505 Banking 7499
North 201506 Energy 6685
North 201507 Automobile 5030
North 201508 Electronics 2922
North 201509 Pharma 7804
North 201510 Construction 4147
North 201511 Banking 5375
North 201512 Energy 4471

Pivot model-1: [NetSales] summary by [Cust_Segment] for [Sales_Region]:
SELECT [Cust_Segment],[East],[West],[South],[North]
 FROM
    (    SELECT [Sales_Region] ,[Cust_Segment],[NetSales] 
           FROM [dbo].[SalesTable] 
    ) T1
PIVOT ( SUM(NetSales
        FOR [Sales_Region] IN ( "East","West", "South","North")
        ) as PVT 
Order by [Cust_Segment]
Go
------------------------------------- OR -----------------------------
SELECT [Cust_Segment],
   SUM([East]) [East], SUM([West]) [West], SUM([South]) [South], 
    SUM([North]) [North]
FROM (
            SELECT [Sales_Region] ,[Cust_Segment],[NetSales] 
            FROM [dbo].[SalesTable] 
            ) T1
PIVOT ( SUM (NetSales
    FOR [Sales_Region] IN ( "East","West", "South","North")
    ) as PVT
Group by [Cust_Segment]

Go

Output:

Pivot model-2: [NetSales] summary by [Cust_Segment] for [Sales_Period]:
SELECT [Cust_Segment],
      SUM([201501])[201501],SUM([201502]) [201502],SUM([201503]) [201503],
        SUM([201504]) [201504],
      SUM([201505])[201505],SUM([201506]) [201506],SUM([201507]) [201507],
        SUM([201508]) [201508],
      SUM([201509])[201509],SUM([201510]) [201510],SUM([201511]) [201511],
        SUM([201512]) [201512]
  FROM(
                SELECT [Cust_Segment],[Sales_Period],[NetSales] 
                FROM [dbo].[SalesTable] 
            ) T1
PIVOT ( SUM(NetSales) 
    FOR [Sales_Period] IN ([201501],[201502],[201503],[201504],[201505],[201506], 
                [201507], [201508], [201509], [201510], [201511], [201512])
    ) as PVT 
Group by [Cust_Segment]
Go

Output :

-------------------------------------------------------------------------------------------------------- 
Thanks, TAMATAM ; Business Intelligence & Analytics Professional 
--------------------------------------------------------------------------------------------------------

Monday, March 20, 2017

What is the difference between Range.Resize and Range.Offset in VBA

Range.Resize Vs Range.Offset in VBA
Range.Resize Method is used to resize the range of cells from the Active cell Range.The Resize property enables you to change the size of a range based off the location of the active cell.
Example :
Sub Rng_Resize()

Range("C3").Resize(3, 3).Select


End Sub

This will select a range of 3 Rows and 3 Columns including the Active Cell range Row and Column, as follows


Notes :
To resize only Columns, you can skip the rows size as follows :
Range("C3").Resize( , 3).Select

To resize only Rows, you can directly specify the rows size as follows :
Range("C3").Resize(3).Select

The range.resize will not allow the Zero as size ; it will throw an error for below methods
Range("C3").Resize(0,3).Select             ----------- Error
Range("C3").Resize(3,0).Select             ----------- Error

----------------------------------------------------------------------------------------------------------------------
Range.Offset Method is used to change the range of Active cell .The Offset property enables you to change the Active cell range to a new range based on offset of rows and columns from the location of the active cell.

Sub Rng_Offset()

Range("C3").Offset(3, 3).Select

End Sub



Notes :
To offset only Columns, you can mae the rows to zero as follows :
Range("C3").Resize( 0, 3).Select

To offset only Rows, you can mae the columns to zero as follows :
Range("C3").Resize(3,0).Select

Thanks, TAMATAM

Friday, March 17, 2017

How to add an Excel Range to an ActiveX ComboBox List on DropButtonClick

VBA Macro to add an Excel Range to an ActiveX ComboBox List on DropButtonClick
Private Sub Cmb_FiscQtr_DropButtonClick()
    Dim WS As Worksheet
    Dim r As Long
    Dim n As Long
    Dim x As Long
    Dim y As Long
    
    Dim OLE_Obj As Object    
    Dim FQ_Items() As Variant

    Set WS = Worksheets("Test")
    Set OLE_Obj = WS.OLEObjects("Cmb_FiscQtr").Object
    On Error Resume Next

'The Range where we have the List      
    x = WS.Range("F65536").End(xlUp).Row

'Re-sizing the Array Size  
    ReDim FQ_Items(1 To x - 9)

'Adding Fiscal Quarters from an Excel Range to the Combobox Dropdown List        
    FQ_Items(1) = "(All)"
    n = 2

    For r = 11 To x
        FQ_Items(n) = WS.Cells(r, 6).Value
        n = n + 1
    Next r

    Cmb_FiscQtr.List = FQ_Items
    
 'Displaying the Combox Box List Items
    y = OLE_Obj.ListCount

    For x = 0 To (y - 1)
    OLE_Obj.ListIndex = x
    MsgBox OLE_Obj.List(x)
    Next x
    
'Erasing the Items from Arrary
    Erase FQ_Items
    Set WS = Nothing
       
End Sub


Example :

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Featured Post from this Blog

How to compare Current Snapshot Data with Previous Snapshot in Power BI

How to Dynamically compare two Snapshots Data in Power BI Scenario: Suppose, we have a sample Sales data, which is stored with Monthly Snaps...

Popular Posts from this Blog