Sunday, 15 October 2017

SQL Server WHILE Loop with BREAK and CONTINUE Keywords

WHILE Loop to Insert Dynamic Date Values into the Table in SQL Server
WHILE Loop statement is used to loop through the body to execute till the Condition evaluates to False.
Since the WHILE condition is evaluated before entering the loop, it is possible that the loop may not execute even once.
The following WHILE Loop example inserts the Dates, Month, Quarter, Year values till '12/31/2020' into the table.

USE TAMATAM
GO

CREATE TABLE Tbl_Dates ([Date_] [Date] NOT NULL PRIMARY KEY CLUSTERED,
      [Week_Number] [Int]  NULL,
      [Week_Day_Name] [Varchar](50) NULL,
      [Month_Number] [Varchar](50) NULL,
      [Month_Name] [Varchar](50) NULL,
      [Qtr_Name] [Varchar](50) NULL,
      [FY_Name] [Varchar](50) NULL,
      [Unique_Id] UniqueIdentifier)
;

-------------------------------------------------------------------------------------------
WHILE Loop :

DECLARE @Val DATE
SET @Val=GETDATE()
PRINT(@Val)
Truncate Table Tbl_Dates

--WHILE Loop Begins here
WHILE @Val <= '12/31/2020'

BEGIN  
INSERT INTO Tbl_Dates
( [Date_], [Week_Number], [Week_Day_Name], [Month_Number],
       [Month_Name],[Qtr_Name],[FY_Name],[Unique_Id])
       VALUES ( @Val,Left(DateName(WW,@Val),3 ),Left(DateName(W,@Val),3 ),
    MONTH(@Val),Left(DateName(MM,@Val),3 ),'Q' + DateName(QQ,@Val),
    'FY' + DateName(YY,@Val),Newid())
  
SELECT @Val=DATEADD(DD,1,@Val)
END
--WHILE Loop Ends here
GO
-------------------------------------------------
Output :
SELECT*FROM Tbl_Dates Order By 1 Desc

SELECT Distinct [FY_Name] FROM Tbl_Dates Order By 1 Desc
FY_Name
FY2017
FY2018
FY2019
FY2020
-------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------
WHILE Loop with BREAK :
The BREAK keyword is used to Break the Loop when a specific Condition is True, explained below :
--WHILE Loop Begins here
WHILE @Val <= '12/31/2020'

BEGIN  
INSERT INTO Tbl_Dates
( [Date_], [Week_Number], [Week_Day_Name], [Month_Number],
       [Month_Name],[Qtr_Name],[FY_Name],[Unique_Id])
       VALUES ( @Val,Left(DateName(WW,@Val),3 ),Left(DateName(W,@Val),3 ),
       MONTH(@Val),Left(DateName(MM,@Val),3 ),'Q' + DateName(QQ,@Val),
       'FY' + DateName(YY,@Val),Newid())
  
   
SELECT @Val=DATEADD(DD,1,@Val)
  IF YEAR(@Val)='2018'
   BREAK; ----WHILE Loop Exits/Stops here when Year=2018
END
--WHILE Loop Ends here
 SELECT Distinct [FY_Name] FROM Tbl_Dates Order By 1
GO

-------------------------------------------------
Output :
SELECT Distinct [FY_Name] FROM Tbl_Dates Order By 1

FY_Name
FY2017
-------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------

WHILE Loop with CONTINUE:
The CONTINUE keyword will stop the Loop to execute Next Lines of Code after it, and make the loop to go to beginning again.
--WHILE Loop Begins here
WHILE @Val <= '12/31/2020'

BEGIN  
INSERT INTO Tbl_Dates
( [Date_], [Week_Number], [Week_Day_Name], [Month_Number],
       [Month_Name],[Qtr_Name],[FY_Name],[Unique_Id])
       VALUES ( @Val,Left(DateName(WW,@Val),3 ),Left(DateName(W,@Val),3 ),
       MONTH(@Val),Left(DateName(MM,@Val),3 ),'Q' + DateName(QQ,@Val),
       'FY' + DateName(YY,@Val),Newid())
 
 
    SELECT @Val=DATEADD(DD,1,@Val)

CONTINUE --The Loop will go to beginning again, and the next lines(The IF condition section) of Code below in the Loop will not execute.
            IF YEAR(@Val)='2018' --This line will not execute
            BREAK;
 --This line will not execute
END
--WHILE Loop Ends here
 SELECT Distinct [FY_Name] FROM Tbl_Dates Order By 1
GO

-------------------------------------------------
Output :
SELECT Distinct [FY_Name] FROM Tbl_Dates Order By 1 Desc

FY_Name
FY2017
FY2018
FY2019
FY2020
-------------------------------------------------------------------------------------------
Thanks, TAMATAM
-------------------------------------------------------------------------------------------


Saturday, 14 October 2017

How to Create a View with Schema Binding in SQL Server

Creating a View with SchemaBinding in SQL Server
The SHEMABINDING is essentially takes the things that your VIEW is depend upon(Tables/other Views), and "Binds" them to that View. The significance of this is that, no one can make alteration(ALTER/DROP) to those underlying objects, unless you drop the Schema-Bound View first.

Notes:
It prevents your VIEW from becoming impact by alterations made to the underlying objects.
If you want to create an Index on you View, you must create it with using the " WITH SCHEMEBINDING" Option.
If you want to create a Schema-Bound user defined Function that references to your View then your View must also be " SCHEMEBINDING".
--------------------------------------------------------------------------------------
Example :
Creating a View with SchemaBinding Option

USE [TAMATAM]
GO


CREATE VIEW vw_EmpDeptDtls

WITH SCHEMABINDING

AS

SELECT
 E.[Emp_Id],
  E.[Emp_Name],
  E.[Gender], 
  E.[Joining_Date],
  E.[Basic_Sal],
  D.[Dept_Id],
  D.[Dept_Name],
  D.[Bonus_Rate],
  J.[Job_Id],
  J.[Job_Title]
  FROM [dbo].[Emp_Test] E Inner Join [dbo].[Dept] D
  ON E.Dept_Id=D.Dept_Id
    Inner Join [dbo].[JobTitles] J
  ON E.Job_Id=J.Job_Id

GO
--------------------------------------------------------------------------------------
Now you can create an Index on the above View to make the Query execution faster :

Create Unique Clustered Index Ind_Vw_EmpDept
On vw_EmpDeptDtls (Emp_Id,Dept_Id,Job_Id)

--------------------------------------------------------------------------------------

Notes :
Now if you try to make any alterations to the underlying objects...
--ALTER TABLE EMP_TEST Drop Column [Job_Id]
--ALTER TABLE EMP_TEST ALTER Column [Emp_Name] Varchar(250)
--Drop Table [Emp_Test]

You will get the following errors...
--The object 'vw_EmpDeptDtls' is dependent on column 'Job_Id'
--ALTER TABLE DROP COLUMN Job_Id failed because one or more objects access this column.
--Cannot DROP TABLE 'Emp_Test' because it is being referenced by object 'vw_EmpDeptDtls'


Please note that :
--You can Alter the underlying objects of the View, by removing the SchemaBinding by altering the View .
--You can drop/alter a Column from the base table, which is not used in the View.
--------------------------------------------------------------------------------------
Thanks, TAMATAM
--------------------------------------------------------------------------------------

How to Protect the Code in View or a Stored Procedure with Encryption in SQL Server

Protecting the Code in View or a Stored Procedure with Encryption in SQL Server
If you wants to Protect(Not able to view) your Source Code of your View/Stored Procedure in SQL Server, you can do it by declaring the "With Encryption" option as explained below.

Please note that, Once you Encrypted the Code "With Encryption" option then there is no way to get it back. Make sure that you stored your source code somewhere for future reference, otherwise you have to re-write the code from scratch.

Creating a View with Encryption :
Create View EncVw_EmpDtls
WITH ENCRYPTION
As
SELECT [Emp_Id],[Emp_Name],[Gender],[Dept_Id],[Basic_Sal]
from [dbo].[Emp_Temp1] Where [Emp_Id]<2345700

GO
------------------------------------------------------------------------------------------
Creating a Stored Procedure with Encryption :
Create Procedure [dbo].[SP_Emp_ByDept_Details]                        
    (
  --Parameter Declaration                          
     @Dept1 as varchar(255) = NULL                   
    ) 
WITH ENCRYPTION                         
  AS 

 --Variables Declaration 
   DECLARE @Get_Dept AS varchar(255)=NULL,
     @SQL_Stmnt AS varchar(255)=NULL 


 BEGIN

   TRUNCATE TABLE Emp_Dtls_ByDept
 --Defining Variable with Where Cluase statement by passing Parameter as value
   SET @Get_Dept =  'WHERE [Dept_Name] ='''+ @Dept1 + ''''
   Print ( @Get_Dept ) 

 --Performing an Operation
   SET @SQL_Stmnt = 'INSERT INTO Emp_Dtls_ByDept SELECT * FROM EMP_Details ' + @Get_Dept
   Print ( @SQL_Stmnt )
   EXEC ( @SQL_Stmnt)

   SELECT*FROM Emp_Dtls_ByDept 
END
------------------------------------------------------------------------------------------
Now if you Try to view the Source Code of your View/SP..
sp_helptext EncVw_EmpDtls
GO
sp_helptext SP_Emp_ByDept_Details
GO

then SQL Server will throw the following error messages :
The text for object 'EncVw_EmpDtls' is encrypted.
The text for object 'SP_Emp_ByDept_Details' is encrypted.
------------------------------------------------------------------------------------------
Thanks, TAMATAM
------------------------------------------------------------------------------------------

How to Handle Runtime Errors in VBA with On Error GoTo Label

On Error GoTo Label to Handle Runtime Errors in VBA
Error Handling refers to the code that is written to handle errors which occur when your application is running. These errors are normally caused by something outside your control like a missing file, database being unavailable, data being invalid etc.
If we think an error is likely to occur at some point during run time, it is good practice to write specific code to handle the error if it occurs and deal with it.


Mostly, the Error Handling technique is used to handle the Run time Errors.

To understand error handling we must first understand the different types of errors in VBA.

Syntax Errors:
The most common errors detected automatically by VBA system .When you type a line and press return, VBA will evaluate the syntax and if it is not correct it will display an error message.

Eg:
If you type 'If' and forget the Then keyword.


Compile Errors :
Compile Errors are recognized by the VBA compiler as being illegal and they are highlighted as errors before your macro even starts to run.
If a Compile Error is an incorrectly formatted line of VBA code, then  the Vba Editor will immediately detect and highlight this, as soon as you attempt to move your cursor away from the specific line of code.
Alternatively, a compile error may be detected at the time you attempt to run your macro but before execution has started.


Eg:

Type Mismatch,
For without Next,
If statement without corresponding End If statement ,
Select without End Select


Runtim Errors:
Runtime errors occur during the execution of your code, and cause the code to stop running.
This type of VBA error is also generally easy to fix, as you will be given details of the nature of the error, and shown the location where the code has stopped running.
Eg:
File Not Found Error,
Path/File Access Error,
Copy Method of Range Class Failed Error


Logical Errors:
Logical Errors, also known as 'bugs', occur during the execution of the VBA code, and allow the code to continue to run to completion. However, the 'bug' may cause the macro to perform unexpected actions or return an incorrect result .
These errors are the most difficult to detect and fix, as there is no way that the VBA compiler can identify and 'point to' the error, in the way that it does for compile and runtime errors.

These types of errors generally occurs by missing the logic in the code designed.
We can identify these errors by observing each step(By pressing ‘F8’) of a Macro running, with Local Window and Watch Widows.

Mostly, the Error Handling technique is used to handle the Run time Errors.
The VBA On Error statement is used for error handling. This statement performs some action when an error occurs during runtime.
There are four different ways to use this statement


1. On Error Goto 0 – The code will clears the Error Handler once it done and then re-enables the Error Checking stops at the line with the error and displays a message.
2. On Error Resume Next – The code will ignores the Error and moves to next line. No error message will be displayed.
3. On Error Goto [label] – The code moves to a specific line or label, where we defined the Error Handling mechanism. No error message is displayed. This is the one we use for error handling.
4. On Error Goto -1 – Clears the current error.


Example :
In the following Macro we have defined various Error Handling Techniques.

Sub VBAerrorDebug()
Dim InpMsg As VbMsgBoxResult
Dim FindTotal As String

'On Error Resume Next

On Error GoTo ErrHand1:
Sheets("MySheet").Select ' Error 1-Sheet Does not Exist
Sheets("Sheet1").Range("A1:C6").Copy
'Clears the above Error Handler1 then Re-Enabling the Error Checking in Further Lines of Code
On Error GoTo 0 'This must declare after you handled the Error.

On Error GoTo ErrHand2:
Sheets("MySheet").Range("A1").Paste ' Error 2-Paste Method Failed
ActiveSheet.Range("A1").Select
'Clears the above Error Handler2 then Re-Enabling the Error Checking in Further Lines of Code
On Error GoTo 0 'This must declare after you handled the Error.

TryAgain:
FindRegion = InputBox("Search for the Region to know Net Sales", "Find a Region Net Sales")

On Error GoTo ErrorHand3: ' Error 3-Search String not Found
ActiveSheet.Cells.Find(FindRegion).Select
MsgBox "The Region " & FindRegion & " Net Sales is : " & Selection.Offset(0, 2).Value, vbOKOnly, "Search Result"
'Clears the above Error Handler3 then Re-Enabling the Error Checking in Further Lines of Code
On Error GoTo 0 'This must declare after you handled the Error.

Exit Sub

ErrHand1: ' Error Handler 1
Sheets.Add.Name = "MySheet"
'Raising your Own Custom Error Message
'Err.Raise 123, "WorkSheet", "Work Sheet Not Found"

'Displaying Default Error Message Details
MsgBox "Error Number :  " & Err.Number & vbCrLf & _
"Error Description :  " & Err.Description _
, vbOKOnly, "Details of Error Handled"

Resume Next 'The will take back the execution of code to the next line where it stops.

ErrHand2: 'Error Handler 2
Sheets("MySheet").Range("A1").Activate
ActiveSheet.Paste

Resume Next

ErrorHand3: 'Error Handler 3
UserResponse = MsgBox("Search Region Not Found", vbRetryCancel, "Search Result")
If UserResponse = vbRetry Then Resume TryAgain
End Sub

--------------------------------------------------------------------------------------
Thanks, TAMATAM
--------------------------------------------------------------------------------------

Saturday, 12 August 2017

SSIS For Each Loop Container Task to Load Multiple Text Files Data to SQL Server Destination

SSIS ForEach Loop Container Task to Load Multiple Source Text Files Data to SQL Server Destination
ForEach Loop Container is used repeat the tasks in a Pacakge. For example load data from each file in a directory to the destination table.

Example :
Suppose if we want load the source data from multiple Text .txt files to SQL Server destination and also need to update the Source File name in one column of the destination table, this can be done using the SSIS Foreach Loop container as follows :

Source Files (.txt) :
The Source files which we want to load to the Destination



 Destination Table :
The Destination Table ( Emp_Temp1) into which the above source files need to load.



Step 1: Creating Variables :
First create the two variables "FileName", "FilePath" and assign the one of the Source File to the variable "FileName" and assign the Source Files folder path to the variable "FilePath" as shown below :



Step 2: Create the Connections for Source and Destination:



Tamatam_DB : It is the Connection the SQL Server Database
Input_Src_Txt : It is the Connection for the Source Text files. 

Step 3: Creating dynamic Connection String for Source:
For Input_Src_Txt connection we have to make the Connection String dynamic to pick each source file as follows :

Go to connection properties and define the "Connection String" in Expressions as follows :



Step 4: Design the Control Flow:
Excute SQL Task : 
In this task we Truncate the destination SQL Table by defining the SQL  Statement as "Truncate Table Emp_Temp1"



For Each Loop Container : 
Add the For Each Loop Container in the Control Flow and set the Properties as follows:
In Collection tab, choose the Folder and Files ( you can use wild cards based on your files naming ) value as below.



Next in the Variable Mappings tab assign the dynamic file name variable "FileName" to store the filename in each loop.


Step 5: Design the Data Flow :
Next design the Data Flow to send the data from Source to Destination as follows :

In the above Data Flow, we have to use the Data Conversion to convert the data from Source format to Destination.

Also we have to the Derived Column transformation to Define a Column to Capture the Source File name, using the Variables as follows :






Now map the Columns to the respective Columns in Destination.

Step 6 : Final Output :
Now all the Text Files data with Source Files name loaded to the destination as follows :










 Thanks, TAMATAM

Thursday, 23 March 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

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
         [ BI Developer ]

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts