Wednesday, June 8, 2016

Query for Multiple CTEs

With CTE1 AS (

Select ProductID,sum(OrderQty) as TotalOrderQty from Sales.SalesOrderDetail

group by ProductID



),
CTE2 as(

Select p.ProductID,pc.ProductCategoryID, pc.Name from Production.Product p join Production.ProductSubcategory psc

on psc.ProductSubcategoryID=p.ProductSubcategoryID

join Production.ProductCategory pc

on pc.ProductCategoryID=psc.ProductCategoryID



)
Select * from (

Select CTE2.ProductCategoryId,CTE2.Name,CTE1.ProductId,CTE1.TotalOrderQty,

rn=ROW_NUMBER() over( PARTITION by CTE2.ProductCategoryId order by CTE1.TotalOrderQty desc)

from CTE1 join CTE2 on cte1.ProductID=cte2.ProductID

) CTE where rn<=3

Tuesday, June 7, 2016

Function in sql for removing weekend

ALTER Function [dbo].[calculateTotalTestData11](@interestCourseId int)   
returns nvarchar(max) --@temptable TABLE (dates datetime)      
AS   
BEGIN  
DECLARE @stDate DateTime;
DECLARE @endDate DateTime;
DECLARE @Location int;
SELECT @stDate=CourseSDate,@endDate=CourseEDate,@Location=LocationId from TRAN_SCINTERESTEDCOURSES where InterestedCourseId=@interestCourseId;
DECLARE @temptable table(dates datetime) ;
; WITH CTE(dt) 
 AS 
 (  
 SELECT @stDate 
 UNION ALL 
 SELECT DATEADD(D,1,dt) FROM CTE 
 where dt < @endDate 
 ) 
  insert into @temptable(dates) 
 select dt  from CTE where (CASE WHEN @location = 5  
 THEN (CASE WHEN DATENAME(dw, dt) = 'FRIDAY' THEN 1 ELSE 0 END)  
 ELSE  ( 
 CASE WHEN @location = 8 OR @location = 9
 THEN ((CASE WHEN DATENAME(dw, dt) = 'SATURDAY' OR  DATENAME(dw, dt) = 'SUNDAY'  THEN 1 ELSE 0 END)) 
 ELSE (CASE WHEN DATENAME(dw, dt) = 'Sunday' THEN 1 ELSE 0 END)  END) 
 END )=1 and dt <> @stDate and dt <>@endDate;
  
 return   STUFF((SELECT DISTINCT '; ' + CONVERT(nvarchar(11),dates,113) FROM @temptable FOR XML PATH(''), TYPE).value('.', 'NVARCHAR(MAX)'), 1, 1, '')


END

Query for Specific Date Falling between Date Range

SELECT TRAN_SCINTERESTEDCOURSES.TrainerId,TRAN_SCINTERESTEDCOURSES.coursesdate,TRAN_SCINTERESTEDCOURSES.courseedate,TRAN_SCINTERESTEDCOURSES.LocationId,MST_LOCATION.LocationName from TRAN_SCINTERESTEDCOURSES  
inner join MST_LOCATION on TRAN_SCINTERESTEDCOURSES.LocationId = MST_LOCATION.LocationId where TrainerId is not null
and     CONVERT(datetime,'2016-05-01')
        between DATEADD(month, DATEDIFF(month, 0, CourseSDate), 0)
            and DATEADD(month, DATEDIFF(month, 0, CourseEDate), 0)

Monday, June 6, 2016

SQL Query for Pivottable

Database CASKoenigDB:
DECLARE @TrainerID INT
DECLARE @CourseSDate DATETIME
DECLARE @CourseEDate DATETIME
DECLARE @LocationId INT
Declare @batchstatus varchar(30)
create TABLE #tbl1 (TrainerID INT,trngdate DATETIME, locationid INT)
DECLARE LDates CURSOR
FOR
SELECT TRAN_SCINTERESTEDCOURSES.TrainerId,TRAN_SCINTERESTEDCOURSES.coursesdate,TRAN_SCINTERESTEDCOURSES.courseedate,TRAN_SCINTERESTEDCOURSES.LocationId,TRAN_SCINTERESTEDCOURSES.tscheduletype as BatchStatus from TRAN_SCINTERESTEDCOURSES
join MST_LOCATION on TRAN_SCINTERESTEDCOURSES.LocationId = MST_LOCATION.LocationId where TrainerId IS NOT NULL
and     CONVERT(datetime,'2016-05-01')
        between DATEADD(month, DATEDIFF(month, 0, coursesdate), 0)
            and DATEADD(month, DATEDIFF(month, 0, courseedate), 0) ORDER BY TRAN_SCINTERESTEDCOURSES.CourseSDate
OPEN LDates
FETCH NEXT FROM LDates
INTO @TrainerID,@CourseSDate,@CourseEDate,@LocationId ,@batchstatus
WHILE @@FETCH_STATUS = 0
BEGIN
INSERT INTO #tbl1

SELECT TrainerID ,trngdate,locationid FROM getFullMonthforRC(@TrainerID,@CourseSDate,@CourseEDate,@LocationId,@batchstatus)
FETCH NEXT FROM LDates

INTO @TrainerID,@CourseSDate,@CourseEDate,@LocationId,@batchstatus
END
CLOSE LDates
DEALLOCATE LDates
select  EmpId, TrainerName,CASE WHEN [1] > 1 THEN 1 ELSE [1] END AS [1],CASE WHEN [2] > 1 THEN 1 ELSE [2] END AS [2],CASE WHEN [3] > 1 THEN 1 ELSE [3] END AS [3],CASE WHEN [4] > 1 THEN 1 ELSE [4] END AS [4],CASE WHEN [5] > 1 THEN 1 ELSE [5] END AS [5],CASE WHEN [6] > 1 THEN 1 ELSE [6] END AS [6],CASE WHEN [7] > 1 THEN 1 ELSE [7] END AS [7],CASE WHEN [8] > 1 THEN 1 ELSE [8] END AS [8],CASE WHEN [9] > 1 THEN 1 ELSE [9] END AS [9],CASE WHEN [10] > 1 THEN 1 ELSE [10] END AS [10],CASE WHEN [11] > 1 THEN 1 ELSE [11] END AS [11],CASE WHEN [12] > 1 THEN 1 ELSE [12] END AS [12],CASE WHEN [13] > 1 THEN 1 ELSE [13] END AS [13],CASE WHEN [14] > 1 THEN 1 ELSE [14] END AS [14],CASE WHEN [15] > 1 THEN 1 ELSE [15] END AS [15],CASE WHEN [16] > 1 THEN 1 ELSE [16] END AS [16],CASE WHEN [17] > 1 THEN 1 ELSE [17] END AS [17],CASE WHEN [18] > 1 THEN 1 ELSE [18] END AS [18],CASE WHEN [19] > 1 THEN 1 ELSE [19] END AS [19],CASE WHEN [20] > 1 THEN 1 ELSE [20] END AS [20],CASE WHEN [21] > 1 THEN 1 ELSE [21] END AS [21],CASE WHEN [22] > 1 THEN 1 ELSE [22] END AS [22],CASE WHEN [23] > 1 THEN 1 ELSE [23] END AS [23],CASE WHEN [24] > 1 THEN 1 ELSE [24] END AS [24],CASE WHEN [25] > 1 THEN 1 ELSE [25] END AS [25],CASE WHEN [26] > 1 THEN 1 ELSE [26] END AS [26],CASE WHEN [27] > 1 THEN 1 ELSE [27] END AS [27],CASE WHEN [28] > 1 THEN 1 ELSE [28] END AS [28],CASE WHEN [29] > 1 THEN 1 ELSE [29] END AS [29],CASE WHEN [30] > 1 THEN 1 ELSE [30] END AS [30],CASE WHEN [31] > 1 THEN 1 ELSE [31] END AS [31]
from
(SELECT distinct t1.EmpId,t1.TrainerName,t2.LocationName, Day(#tbl1.trngdate)as CourseDate FROM #tbl1 join MST_TRAINER t1
on #tbl1.TrainerID=t1.TrainerId LEFT Join MST_LOCATION t2 on t2.LocationId=#tbl1.locationid where t1.EmpId is not null  AND MONTH(#tbl1.trngdate)='05' ) RC
Pivot
(
COUNT(LocationName) for CourseDate in([1],[2],[3],[4],[5],[6],[7],[8],[9],[10],[11],[12],[13],[14],[15],[16],[17],[18],[19],[20],[21],[22],[23],[24],[25],[26],[27],[28],[29],[30],[31])
)as Pivottable

Drop table #tbl1






SQL Query for Split Date

Database : CASKoenigDB

DECLARE @TrainerID INT

DECLARE @CourseSDate DATETIME

DECLARE @CourseEDate DATETIME

Declare @GDate datetime

DECLARE @LocationId INT

CREATE TABLE #tbl1 (TrainerID INT,GDate DATETIME, LocationId INT)

DECLARE LDates CURSOR

FOR

SELECT IC.TrainerId ,IC.CourseSDate,IC.CourseEDate,IC.LocationId

FROM TRAN_SCINTERESTEDCOURSES IC

WHERE IC.LocationId IN (1,2,3,4,5,6) AND IC.TrainerId IS NOT NULL AND IC.CourseSDate>'2016-03-31'

AND CourseEDate<='2016-04-30' ORDER BY IC.CourseSDate

OPEN LDates

FETCH NEXT FROM LDates

INTO @TrainerID,@CourseSDate,@CourseEDate,@LocationId

WHILE @@FETCH_STATUS = 0

BEGIN

INSERT INTO #tbl1

SELECT TrainerID ,trngdate,LocationId

FROM getFullMonthforRC(@TrainerID,@CourseSDate,@CourseEDate,@LocationId)

FETCH NEXT FROM LDates

INTO @TrainerID,@CourseSDate,@CourseEDate,@LocationId

END

CLOSE LDates

DEALLOCATE LDates

SELECT * FROM #tbl1

DROP TABLE #tbl1

Function in SQL

USE [CASKOENIGDB]
GO
/****** Object:  UserDefinedFunction [dbo].[getFullMonthforRC]    Script Date: 06/08/2016 17:17:25 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER function [dbo].[getFullMonthforRC](@TrainerID int,@CourseSDate datetime,@CourseEDate datetime,@LocationId int,@weekendstatus varchar(30))
returns  @TableofDates table(TrainerID int not null,trngdate datetime not null,locationid int not null)
Begin
declare @trnid int
declare @lnid int
Declare @startDate datetime
declare @weekendbatch varchar(30)
set @trnid=@TrainerID
set @startDate=@CourseSDate
Declare @endDate datetime
set @endDate=@CourseEDate
set @lnid=@LocationId
set @weekendbatch=@weekendstatus
while @startDate<=@endDate
begin

if (@weekendbatch ='Weekend')  begin
IF (DATENAME(W,@startDate)='SATURDAY' or DATENAME(W,@startDate)= 'SUNDAY') BEGIN
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
END
ELSE BEGIN
set @startDate=DATEADD(DAY, 1, @startDate)

END
end
else IF CharIndex('5 Days',@weekendbatch)>0 begin
if @lnid= 5 begin
IF (DATENAME(W,@startDate)='THURSDAY' or DATENAME(W,@startDate)= 'FRIDAY') BEGIN
set @startDate=DATEADD(DAY, 1, @startDate)
END
ELSE BEGIN
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
END
end
else begin
IF (DATENAME(W,@startDate)='SUNDAY' or DATENAME(W,@startDate)= 'SATURDAY') BEGIN
set @startDate=DATEADD(DAY, 1, @startDate)
END
ELSE BEGIN
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
END
end
end
else IF CharIndex('7 Days',@weekendbatch)>0 begin
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
end
else IF CharIndex('Daily',@weekendbatch)>0 begin
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
end
else IF CharIndex('Weekly',@weekendbatch)>0 begin
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
end
else IF CharIndex('6 Days',@weekendbatch)>0 begin
if @lnid= 5 begin
IF  DATENAME(W,@startDate)= 'FRIDAY' BEGIN
set @startDate=DATEADD(DAY, 1, @startDate)
END
ELSE BEGIN
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
END
end
else begin
IF DATENAME(W,@startDate)='SUNDAY'  BEGIN
set @startDate=DATEADD(DAY, 1, @startDate)
END
ELSE BEGIN
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
END
end

end
else if @weekendbatch is null begin
INSERT INTO @TableOfDates(TrainerID,trngdate,locationid) VALUES (@trnid,@startDate,@lnid)
set @startDate=DATEADD(DAY, 1, @startDate)
end
end
return
End

Wednesday, June 1, 2016

Window Service

http://www.c-sharpcorner.com/uploadfile/naresh.avari/develop-and-install-a-windows-service-in-c-sharp/

Wednesday, May 25, 2016

Create PPT in VBA

Dim sheetcount As Long, rowcount As Long, datarng As Range, i As Integer
Dim chrt As Excel.ChartObject, tempwb As Workbook, temprng As Range, mainrng As Range
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation, fullPath As String
Dim pptsld As PowerPoint.Slide, filename As String
Dim fso As FileSystemObject, fldr As Folder, fl As File
Dim ppLayoutBlank As CustomLayout
Dim oPic As Shape, objSlideShow As Object, temprowcount As Long
Sub copyrange2image()
Application.ScreenUpdating = False
'On Error Resume Next
sheetcount = ThisWorkbook.Sheets.Count
Set fso = New FileSystemObject
Set fldr = fso.GetFolder(ThisWorkbook.Path & "\")
rowcount = ThisWorkbook.Sheets(sheetcount).Range("A6").End(xlDown).Row
ThisWorkbook.Sheets(sheetcount).Range("A6:J" & rowcount).Sort key1:=ThisWorkbook.Sheets(sheetcount).Range("H6"), order1:=xlAscending, Header:=xlYes
i = 6
l = 0
'Delete Existing image
    For Each fl In fldr.Files
        If InStr(fl.Name, "png") > 0 Then
            Kill ThisWorkbook.Path & "\" & fl.Name
        'ElseIf InStr(fl.Name, ".pptx") > 0 Then
          '  Kill ThisWorkbook.Path & "\" & fl.Name
        End If
    Next
   Do
    Set datarng = Nothing
    Set headerrng = Nothing
       If ((i + 11) < rowcount) Then
       l = l + 1
            
             Set rng1 = ThisWorkbook.Sheets(sheetcount).Range("H" & (i + 1) & ":H" & (i + 11))
            
             Set rng2 = ThisWorkbook.Sheets(sheetcount).Range("A" & (i + 1) & ":A" & (i + 11))
             Set rng3 = ThisWorkbook.Sheets(sheetcount).Range("E" & (i + 1) & ":E" & (i + 11))
            
             Set rng5 = ThisWorkbook.Sheets(sheetcount).Range("G" & (i + 1) & ":G" & (i + 11))
             Set rng6 = ThisWorkbook.Sheets(sheetcount).Range("C" & (i + 1) & ":C" & (i + 11))
            
             Set tempwb = Nothing
             Set tempwb = Workbooks.Add
             Set temprng = Nothing
             temprowcount = 0
             'Stunt Name
             ThisWorkbook.Sheets(sheetcount).Range("H6").Copy tempwb.Sheets(1).Range("A1")
             rng1.Copy tempwb.Sheets(1).Range("A2")
             ' Lab no
             ThisWorkbook.Sheets(sheetcount).Range("A6").Copy tempwb.Sheets(1).Range("B1")
             rng2.Copy tempwb.Sheets(1).Range("B2")
             'Start Date
             ThisWorkbook.Sheets(sheetcount).Range("E6").Copy tempwb.Sheets(1).Range("C1")
             rng3.Copy tempwb.Sheets(1).Range("C2")
            
             'Course Name
             ThisWorkbook.Sheets(sheetcount).Range("G6").Copy tempwb.Sheets(1).Range("D1")
             rng5.Copy tempwb.Sheets(1).Range("D2")
             'Trainer Name
             ThisWorkbook.Sheets(sheetcount).Range("C6").Copy tempwb.Sheets(1).Range("E1")
             temprowcount = tempwb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
             rng6.Copy tempwb.Sheets(1).Range("E2")
             tempwb.Sheets(1).Columns(1).ColumnWidth = 108
             tempwb.Sheets(1).Columns(2).ColumnWidth = 12
             tempwb.Sheets(1).Columns(3).ColumnWidth = 15
             tempwb.Sheets(1).Columns(4).ColumnWidth = 90
             tempwb.Sheets(1).Columns(5).ColumnWidth = 15
             Set temprng = tempwb.Sheets(1).Range("A1:E" & temprowcount)
            
             'Application.Wait (Now + TimeValue("0:00:02"))
             temprng.CopyPicture xlScreen, xlPicture
             Set chrt = tempwb.Sheets(1).ChartObjects.Add(0, 0, temprng.Width - 10, temprng.Height - 10)
             chrt.Activate
             chrt.Chart.Paste
             chrt.Chart.Export ThisWorkbook.Path & "\mydata" & l & ".png"
             chrt.Delete
             Application.DisplayAlerts = False
            tempwb.Close
            Set chrt = Nothing
       ElseIf ((i + 11) > rowcount) Then
       l = l + 1
             Set rng1 = ThisWorkbook.Sheets(sheetcount).Range("H" & (i + 1) & ":H" & (i + 11))
            
             Set rng2 = ThisWorkbook.Sheets(sheetcount).Range("A" & (i + 1) & ":A" & (i + 11))
             Set rng3 = ThisWorkbook.Sheets(sheetcount).Range("E" & (i + 1) & ":E" & (i + 11))
            
             Set rng5 = ThisWorkbook.Sheets(sheetcount).Range("G" & (i + 1) & ":G" & (i + 11))
             Set rng6 = ThisWorkbook.Sheets(sheetcount).Range("C" & (i + 1) & ":C" & (i + 11))
            
            
             Set tempwb = Workbooks.Add
             'Stunt Name
             ThisWorkbook.Sheets(sheetcount).Range("H6").Copy tempwb.Sheets(1).Range("A1")
             rng1.Copy tempwb.Sheets(1).Range("A2")
             ' Lab no
             ThisWorkbook.Sheets(sheetcount).Range("A6").Copy tempwb.Sheets(1).Range("B1")
             rng2.Copy tempwb.Sheets(1).Range("B2")
             'Start Date
             ThisWorkbook.Sheets(sheetcount).Range("E6").Copy tempwb.Sheets(1).Range("C1")
             rng3.Copy tempwb.Sheets(1).Range("C2")
            
             'Course Name
             ThisWorkbook.Sheets(sheetcount).Range("G6").Copy tempwb.Sheets(1).Range("D1")
             rng5.Copy tempwb.Sheets(1).Range("D2")
             'Trainer Name
             ThisWorkbook.Sheets(sheetcount).Range("C6").Copy tempwb.Sheets(1).Range("E1")
             temprowcount = tempwb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
             rng6.Copy tempwb.Sheets(1).Range("E2")
             tempwb.Sheets(1).Columns(1).ColumnWidth = 108
             tempwb.Sheets(1).Columns(2).ColumnWidth = 12
             tempwb.Sheets(1).Columns(3).ColumnWidth = 15
             tempwb.Sheets(1).Columns(4).ColumnWidth = 90
             tempwb.Sheets(1).Columns(5).ColumnWidth = 15
             Set temprng = tempwb.Sheets(1).Range("A1:E" & temprowcount)
             'Application.Wait (Now + TimeValue("0:00:02"))
             temprng.CopyPicture xlScreen, xlPicture
             Set chrt = tempwb.Sheets(1).ChartObjects.Add(0, 0, temprng.Width - 10, temprng.Height - 10)
             chrt.Activate
             chrt.Chart.Paste
             chrt.Chart.Export ThisWorkbook.Path & "\mydata" & l & ".png"
             chrt.Delete
            Application.DisplayAlerts = False
            tempwb.Close
            Set chrt = Nothing
       End If
        i = i + 11
       
       
        Loop Until i >= rowcount
    'Counting total images
   
   
   
    'Adding slide & pic to Presentation
        Set pptApp = CreateObject("Powerpoint.Application")
            pptApp.Visible = True
            pptApp.Activate
        Set pptPres = pptApp.Presentations.Add
        k = 0
       
     For Each fl In fldr.Files
        If InStr(fl.Name, "png") > 0 Then
            k = k + 1
            Set pptsld = pptPres.Slides.Add(pptPres.Slides.Count + 1, Layout:=ppLayoutCustom)
            fullPath = ThisWorkbook.Path & "\" & "mydata" & k & ".png"
            pptsld.FollowMasterBackground = msoFalse
            pptsld.Background.Fill.UserPicture ThisWorkbook.Path & "\Picture1.jpg"
            pptsld.Shapes.AddPicture filename:=fullPath, linktofile:=msoTrue, savewithdocument:=msoTrue, Left:=0, Top:=110, Width:=961, Height:=240
            pptsld.SlideShowTransition.EntryEffect = ppEffectBlindsHorizontal
            pptsld.SlideShowTransition.AdvanceOnTime = True
            pptsld.SlideShowTransition.AdvanceTime = 10
   
  
        End If
           
    Next
    For m = 1 To pptPres.Slides.Count
   
    pptPres.Slides(m).HeadersFooters.SlideNumber.Visible = True
    Next
    pptPres.SaveAs ThisWorkbook.Path & "\BatchSchedulePresentation.pptx"
    pptPres.SlideShowSettings.StartingSlide = 1
    pptPres.SlideShowSettings.EndingSlide = pptPres.Slides.Count
    pptPres.SlideShowSettings.LoopUntilStopped = msoTrue
    pptPres.Save
    'pptPres.SlideShowSettings.Run
    pptPres.Close
    pptApp.Quit
  
   
   
    Set pptsld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    Call slideShow
End Sub
Public Sub slideShow()
On Error Resume Next


Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open(ThisWorkbook.Path & "\BatchSchedulePresentation.pptx")
For Each pptsld In objPresentation.Slides
       pptsld.SlideShowTransition.EntryEffect = ppEffectPush
       pptsld.SlideShowTransition.AdvanceOnTime = True
       pptsld.SlideShowTransition.AdvanceTime = 4
Next
objPPT.ActiveWindow.View.GotoSlide 1
 With objPresentation.SlideShowSettings
        .StartingSlide = 1
        .EndingSlide = objPresentation.Slides.Count
        .AdvanceMode = ppSlideShowUseSlideTimings
 
        .LoopUntilStopped = msoTrue
        .Run

        End With

objPresentation.Saved = True


End Sub

DownloadFile



backgroundimage

Thursday, May 19, 2016

My First Stored procedure

create proc mentee
@Type int=0,
@domainName varchar(90)=''
as
begin

if @Type=1
begin
Select empName from empDetails  where empCode in(Select empReportingMgrId from  empDetails) and empDomainame LIKE '%'+@domainName+'%';
end
end

Monday, May 16, 2016

Sending Mails from Specific Account in Outlook

Public Sub sendMail(ByRef myrng As Range, ByRef modulename As String)
On Error Resume Next
    Set olNS = Application.GetNamespace("MAPI")
    Set outlukApp = New Outlook.Application
    Set outlukMailitem = outlukApp.CreateItem(olMailItem)
 
    If modulename = "Newjoineemail" Then
            With outlukMailitem
                    .SendUsingAccount = olNS.Accounts.Item(2)
                    .Display
                    .To = "neeti.seth@koenig-solutions.com"
                    .BCC = "sakshi.dhawan@koenig-solutions.com;ruchika.dhir@koenig-solutions.com; pooja.sharma@koenig-solutions.com; praveen@koenig-solutions.com; sonia.sharma@koenig-solutions.com; shekhar@koenig-solutions.com; rajesh.khandelwal@koenig-solutions.com; meghana.anand@koenig-solutions.com; anuradha.pant@koenig-solutions.com; Gayatri.chauhan@koenig-solutions.com; Arpit.gupta@koenig-solutions.com; puja.prasad@koenig-solutions.com; ea@koenig-solutions.com; mansi.malik@koenig-solutions.com; silky.bhateja@koenig-solutions.com; shruti.kapoor@koenig-solutions.com; amit@koenig-solutions.com; teamrecruitment@koenig-solutions.com; generalist@koenig-solutions.com; kt@koenig-solutions.com; raman.thakur@koenig-solutions.com; geeta.gakhar@koenig-solutions.com; jaishree.pal@koenig-solutions.com; amit.garg@koenig-solutions.com ; pooja.gautam@koenig-solutions.com"
                    .Subject = "New Joinee Details"
           
                    .HTMLBody = "<p>Dear All,<br><br>The below mentioned have joined Koenig as:</p><br><br>" & RangetoHTML(myrng) & "<br>" & .HTMLBody
           
            End With
    ElseIf modulename = "lastworkingDay" Then
 
            With outlukMailitem
                    .Display
                    .To = "managers@koenig-solutions.com"
                    .Subject = "Left Employee"
           
                    .HTMLBody = "<p>Dear Managers,<br><br>Please note that the last working day of following employee:</p><br><br>" & RangetoHTML(myrng) & "<br>" & .HTMLBody
           
            End With
    ElseIf modulename = "Newjoineemail2" Then
 
            With outlukMailitem
                    .Display
                    .To = "neeti.seth@koenig-solutions.com"
                    .Subject = "New Joinee"
                    .BCC = "managers@koenig-solutions.com;ruchika.dhir@koenig-solutions.com;neha.maggon@koenig-solutions.com; meghana.anand@koenig-solutions.com; Gayatri.chauhan@koenig-solutions.com; neetu.a@koenig-solutions.com; sonia.sharma@koenig-solutions.com; ranjan.manish@koenig-solutions.com; shruti.kapoor@koenig-solutions.com; anuradha.pant@koenig-solutions.com; teamrecruitment@koenig-solutions.com; generalist@koenig-solutions.com; resource@koenig-solutions.com; geeta.gakhar@koenig-solutions.com; raman.thakur@koenig-solutions.com; jaishree.pal@koenig-solutions.com; pooja.gautam@koenig-solutions.com"


                    .HTMLBody = "<p>Dear All,<br><br>The below mentioned have joined Koenig as:</p><br><br>" & RangetoHTML(myrng) & "<br>" & .HTMLBody
           
            End With
         
 
    End If
End Sub

Friday, April 29, 2016

Day between two Dates

Sub daybetwwen2dates()
    startdate = CDate(Application.InputBox("Date", Default:=Date + 1))
    enddate = CDate(Application.InputBox("Date", Default:=Date + 2))
    MsgBox DateDiff("d", startdate, enddate) + 1
End Sub

Wednesday, March 9, 2016

Search Specific File in all Folders/SubFolders

Searching  ''CamRecorder.exe'' in C:\ drive


Sub SearchSpecificFile()
 Dim colFiles As New Collection
     RecursiveDir colFiles, "C:\", "CamRecorder.exe", True
     Dim vFile As Variant
     For Each vFile In colFiles
         MsgBox vFile
     Next vFile

End Sub
Public Function RecursiveDir(colFiles As Collection, _
                              strFolder As String, _
                              strFileSpec As String, _
                              bIncludeSubfolders As Boolean)
On Error Resume Next
     Dim strTemp As String
     Dim colFolders As New Collection
     Dim vFolderName As Variant
     'Add files in strFolder matching strFileSpec to colFiles
     strFolder = TrailingSlash(strFolder)
     strTemp = Dir(strFolder & strFileSpec)
     Do While strTemp <> vbNullString
         colFiles.Add strFolder & strTemp
         strTemp = Dir
     Loop
     If bIncludeSubfolders Then
         'Fill colFolders with list of subdirectories of strFolder
         strTemp = Dir(strFolder, vbDirectory)
         Do While strTemp <> vbNullString
             If (strTemp <> ".") And (strTemp <> "..") Then
                 If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                     colFolders.Add strTemp
                 End If
             End If
             strTemp = Dir
         Loop
         'Call RecursiveDir for each subfolder in colFolders
         For Each vFolderName In colFolders
             Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
         Next vFolderName
     End If
End Function

Public Function TrailingSlash(strFolder As String) As String
     If Len(strFolder) > 0 Then
         If Right(strFolder, 1) = "\" Then
             TrailingSlash = strFolder
         Else
             TrailingSlash = strFolder & "\"
         End If
     End If
End Function



Wednesday, February 24, 2016

Press {Enter} key in InputBox of URL to enable Login

Sub loginWebWeX()

Dim htmldoc As HTMLDocument
Dim frm As Object
Dim objCollection As Object
Dim browser As InternetExplorer
Dim link As Object

Dim mainurl
Dim grandtotalinventory As Long
mainurl = ThisWorkbook.Sheets(1).Range("B1")
Set browser = New InternetExplorer
'On Error Resume Next
browser.Visible = True
browser.navigate mainurl
Do While browser.Busy Or browser.ReadyState <> READYSTATE_COMPLETE
DoEvents
   
Loop
  
    Set htmldoc = browser.document
    'Set objCollection = htmldoc.frames.Length
    j = 1
    i = 0
    Do
    Loop Until Not (browser.Busy)
   
   
     Set objCollection = htmldoc.frames(0).document.getElementsByTagName("a")
    
    
    
      
           For Each link In objCollection
                If link.innerHTML = "Log In" Then
                    link.Click
                End If
           Next
       Set htmldoc = browser.document
       Do
    Loop Until Not (browser.Busy)
    Set objCollection = htmldoc.frames(1).document.getElementsByTagName("input")
   
        k = 0
         While k < objCollection.Length
            If objCollection(k).Name = "userName" Then
                objCollection(k).Value = ThisWorkbook.Sheets(1).Range("A1")
                objCollection(k).Focus
                Application.SendKeys ("{ENTER}")
               
            ElseIf objCollection(k).Name = "password" Then
                objCollection(k).Value = ThisWorkbook.Sheets(1).Range("A2")
            ElseIf objCollection(k).ID = "mwx-btn-logon" Then
                Application.Wait (Now + TimeValue("0:00:03"))
                objCollection(k).Click
           
            End If
         k = k + 1
        Wend
       
      
    Set objCollection = Nothing
    Set objElement = Nothing
    Set htmldoc = Nothing
    Set browser = Nothing
    Exit Sub
errorhandler:
  MsgBox Err.Description
   


End Sub

Wednesday, February 17, 2016

Friday, January 15, 2016

VBA code.... insert query for new new records update for existing records

Dim conn As ADODB.Connection, rst As ADODB.Recordset, myarray
Dim rowcount As Long, updatequery As String
Dim apprisaldate1 As String, apprisaldate2 As String, apprisaldate3 As String, apprisaldate4 As String, apprisaldate5 As String, apprisaldate6 As String, apprisaldate7 As String, apprisaldate8 As String, apprisaldate9 As String, apprisaldate10 As String
Dim lastsalary1 As String, lastsalary2 As String, lastsalary3 As String, lastsalary4 As String, lastsalary5 As String, lastsalary6 As String, lastsalary7 As String, lastsalary8 As String, lastsalary9 As String, lastsalary10 As String
Dim revisedsalary1 As String, revisedsalary2 As String, revisedsalary3 As String, revisedsalary4 As String, revisedsalary5 As String, revisedsalary6 As String, revisedsalary7 As String, revisedsalary8 As String, revisedsalary9 As String, revisedsalary10 As String
Sub insertecord()
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets(1).AutoFilterMode = False
   ' On Error GoTo errorHandler
    rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
   
    Set conn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    conn.ConnectionString = "Data Source=HRAutomation;Initial Catalog=KoenigDb;uid=sa;pwd=Pa$$w0rd;"
    conn.Open
    'rst.Open "EmpAppraisal", conn, adOpenKeyset, adLockBatchOptimistic, adCmdTable
    For i = 2 To rowcount
    'MsgBox "Emp Id" & ThisWorkbook.Sheets(1).Range("A" & i)
   
    Set rst = conn.Execute("Select * from EmpAppraisal where [Employee ID]='" & ThisWorkbook.Sheets(1).Range("A" & i) & "';")
    If Not rst.EOF Then
        myarray = rst.GetRows
        If UBound(myarray) > 0 Then
            apprisaldate1 = ThisWorkbook.Sheets(1).Range("B" & i)
            apprisaldate2 = ThisWorkbook.Sheets(1).Range("E" & i)
            apprisaldate3 = ThisWorkbook.Sheets(1).Range("H" & i)
            apprisaldate4 = ThisWorkbook.Sheets(1).Range("K" & i)
            apprisaldate5 = ThisWorkbook.Sheets(1).Range("N" & i)
            apprisaldate6 = ThisWorkbook.Sheets(1).Range("Q" & i)
            apprisaldate7 = ThisWorkbook.Sheets(1).Range("T" & i)
            apprisaldate8 = ThisWorkbook.Sheets(1).Range("W" & i)
            apprisaldate9 = ThisWorkbook.Sheets(1).Range("Z" & i)
            apprisaldate10 = ThisWorkbook.Sheets(1).Range("AC" & i)
           
            lastsalary1 = ThisWorkbook.Sheets(1).Range("C" & i)
            lastsalary2 = ThisWorkbook.Sheets(1).Range("F" & i)
            lastsalary3 = ThisWorkbook.Sheets(1).Range("I" & i)
            lastsalary4 = ThisWorkbook.Sheets(1).Range("L" & i)
            lastsalary5 = ThisWorkbook.Sheets(1).Range("O" & i)
            lastsalary6 = ThisWorkbook.Sheets(1).Range("R" & i)
            lastsalary7 = ThisWorkbook.Sheets(1).Range("U" & i)
            lastsalary8 = ThisWorkbook.Sheets(1).Range("X" & i)
            lastsalary9 = ThisWorkbook.Sheets(1).Range("AA" & i)
            lastsalary10 = ThisWorkbook.Sheets(1).Range("AD" & i)
           
           
            revisedsalary1 = ThisWorkbook.Sheets(1).Range("D" & i)
            revisedsalary2 = ThisWorkbook.Sheets(1).Range("G" & i)
            revisedsalary3 = ThisWorkbook.Sheets(1).Range("J" & i)
            revisedsalary4 = ThisWorkbook.Sheets(1).Range("M" & i)
            revisedsalary5 = ThisWorkbook.Sheets(1).Range("P" & i)
            revisedsalary6 = ThisWorkbook.Sheets(1).Range("S" & i)
            revisedsalary7 = ThisWorkbook.Sheets(1).Range("V" & i)
            revisedsalary8 = ThisWorkbook.Sheets(1).Range("Y" & i)
            revisedsalary9 = ThisWorkbook.Sheets(1).Range("AB" & i)
            revisedsalary10 = ThisWorkbook.Sheets(1).Range("AE" & i)
            updatequery = "Update EmpAppraisal set [Appraisal/Increment Date1]='" & apprisaldate1 & "',[Last Salary1]='" & lastsalary1 & "',[Revised Salary1]='" & revisedsalary1 & "',[Appraisal/Increment Date2]='" & apprisaldate2 & "',[Last Salary2]='" & lastsalary2 & "',[Revised Salary2]='" & revisedsalary2 & "',[Appraisal/Increment Date3]='" & apprisaldate3 & "',[Last Salary3]='" & lastsalary3 & "',[Revised Salary3]='" & revisedsalary3 & "',[Appraisal/Increment Date4]='" & apprisaldate4 & "',[Last Salary4]='" & lastsalary4 & "',[Revised Salary4]='" & revisedsalary4 & "',[Appraisal/increment Date5]='" & apprisaldate5 & "',[Last Salary5]='" & lastsalary5 & "',[Revised Salary5]='" & revisedsalary5 & "',[Appraisal/increment Date6]='" & apprisaldate6 & "',[Last Salary6]='" & lastsalary6 & "',[Revised Salary6]='" & revisedsalary6 & "',[Appraisal/increment Date7]='" & apprisaldate7 & "',[Last Salary7]='" & lastsalary7 & "',[Revised Salary7]='" & revisedsalary7 & "',[Appraisal/increment Date8]='" & apprisaldate8 _
& "',[Last Salary8]='" & lastsalary8 & "',[Revised Salary8]='" & revisedsalary8 & "',[Appraisal/increment Date9]='" & apprisaldate9 & "',[Last Salary9]='" & lastsalary9 & "',[Revised Salary9]='" & revisedsalary9 & "',[Appraisal/increment Date10]='" & apprisaldate10 & "',[Last Salary10]='" & lastsalary10 & "',[Revised Salary10]='" & revisedsalary10 & "' where [Employee ID]='" & ThisWorkbook.Sheets(1).Range("A" & i) & "';"
            conn.Execute (updatequery)
        Else
            apprisaldate1 = ThisWorkbook.Sheets(1).Range("B" & i)
            apprisaldate2 = ThisWorkbook.Sheets(1).Range("E" & i)
            apprisaldate3 = ThisWorkbook.Sheets(1).Range("H" & i)
            apprisaldate4 = ThisWorkbook.Sheets(1).Range("K" & i)
            apprisaldate5 = ThisWorkbook.Sheets(1).Range("N" & i)
            apprisaldate6 = ThisWorkbook.Sheets(1).Range("Q" & i)
            apprisaldate7 = ThisWorkbook.Sheets(1).Range("T" & i)
            apprisaldate8 = ThisWorkbook.Sheets(1).Range("W" & i)
            apprisaldate9 = ThisWorkbook.Sheets(1).Range("Z" & i)
            apprisaldate10 = ThisWorkbook.Sheets(1).Range("AC" & i)
           
            lastsalary1 = ThisWorkbook.Sheets(1).Range("C" & i)
            lastsalary2 = ThisWorkbook.Sheets(1).Range("F" & i)
            lastsalary3 = ThisWorkbook.Sheets(1).Range("I" & i)
            lastsalary4 = ThisWorkbook.Sheets(1).Range("L" & i)
            lastsalary5 = ThisWorkbook.Sheets(1).Range("O" & i)
            lastsalary6 = ThisWorkbook.Sheets(1).Range("R" & i)
            lastsalary7 = ThisWorkbook.Sheets(1).Range("U" & i)
            lastsalary8 = ThisWorkbook.Sheets(1).Range("X" & i)
            lastsalary9 = ThisWorkbook.Sheets(1).Range("AA" & i)
            lastsalary10 = ThisWorkbook.Sheets(1).Range("AD" & i)
           
           
            revisedsalary1 = ThisWorkbook.Sheets(1).Range("D" & i)
            revisedsalary2 = ThisWorkbook.Sheets(1).Range("G" & i)
            revisedsalary3 = ThisWorkbook.Sheets(1).Range("J" & i)
            revisedsalary4 = ThisWorkbook.Sheets(1).Range("M" & i)
            revisedsalary5 = ThisWorkbook.Sheets(1).Range("P" & i)
            revisedsalary6 = ThisWorkbook.Sheets(1).Range("S" & i)
            revisedsalary7 = ThisWorkbook.Sheets(1).Range("V" & i)
            revisedsalary8 = ThisWorkbook.Sheets(1).Range("Y" & i)
            revisedsalary9 = ThisWorkbook.Sheets(1).Range("AB" & i)
            revisedsalary10 = ThisWorkbook.Sheets(1).Range("AE" & i)
           
           
insertquery = "insert EmpAppraisal([Employee ID], [Appraisal/Increment Date1],[Last Salary1],[Revised Salary1],[Appraisal/Increment Date2],[Last Salary2],[Revised Salary2],[Appraisal/Increment Date3],[Last Salary3],[Revised Salary3],[Appraisal/Increment Date4],[Last Salary4],[Revised Salary4],[Appraisal/increment Date5],[Last Salary5],[Revised Salary5],[Appraisal/increment Date6],[Last Salary6],[Revised Salary6],[Appraisal/increment Date7],[Last Salary7],[Revised Salary7],[Appraisal/increment Date8],[Last Salary8],[Revised Salary8],[Appraisal/increment Date9],[Last Salary9],[Revised Salary9],[Appraisal/increment Date10],[Last Salary10],[Revised Salary10])" _
& "values('" & empId & "','" & apprisaldate1 & "','" & lastsalary1 & "','" & revisedsalary1 & "','" & apprisaldate2 & "','" & lastsalary2 & "','" & revisedsalary2 & "','" & apprisaldate3 & "','" & lastsalary3 & "','" & revisedsalary3 & "','" & apprisaldate4 & "','" & lastsalary4 & "','" & revisedsalary4 & "','" & apprisaldate5 & "','" & lastsalary5 & "','" & revisedsalary5 & "','" & apprisaldate6 & "'," _
& "'" & lastsalary6 & "','" & revisedsalary6 & "','" & apprisaldate7 & "','" & lastsalary7 & "','" & revisedsalary7 & "','" & apprisaldate8 _
& "','" & lastsalary8 & "','" & revisedsalary8 & "','" & apprisaldate9 & "','" & lastsalary9 & "','" & revisedsalary9 & "','" & apprisaldate10 & "','" & lastsalary10 & "','" & revisedsalary10 & "');"
            conn.Execute (insertquery)
            'ThisWorkbook.Sheets(1).Range("B4") = insertquery
        End If
    Else
            empId = ThisWorkbook.Sheets(1).Range("A" & i)
            apprisaldate1 = ThisWorkbook.Sheets(1).Range("B" & i)
            apprisaldate2 = ThisWorkbook.Sheets(1).Range("E" & i)
            apprisaldate3 = ThisWorkbook.Sheets(1).Range("H" & i)
            apprisaldate4 = ThisWorkbook.Sheets(1).Range("K" & i)
            apprisaldate5 = ThisWorkbook.Sheets(1).Range("N" & i)
            apprisaldate6 = ThisWorkbook.Sheets(1).Range("Q" & i)
            apprisaldate7 = ThisWorkbook.Sheets(1).Range("T" & i)
            apprisaldate8 = ThisWorkbook.Sheets(1).Range("W" & i)
            apprisaldate9 = ThisWorkbook.Sheets(1).Range("Z" & i)
            apprisaldate10 = ThisWorkbook.Sheets(1).Range("AC" & i)
           
            lastsalary1 = ThisWorkbook.Sheets(1).Range("C" & i)
            lastsalary2 = ThisWorkbook.Sheets(1).Range("F" & i)
            lastsalary3 = ThisWorkbook.Sheets(1).Range("I" & i)
            lastsalary4 = ThisWorkbook.Sheets(1).Range("L" & i)
            lastsalary5 = ThisWorkbook.Sheets(1).Range("O" & i)
            lastsalary6 = ThisWorkbook.Sheets(1).Range("R" & i)
            lastsalary7 = ThisWorkbook.Sheets(1).Range("U" & i)
            lastsalary8 = ThisWorkbook.Sheets(1).Range("X" & i)
            lastsalary9 = ThisWorkbook.Sheets(1).Range("AA" & i)
            lastsalary10 = ThisWorkbook.Sheets(1).Range("AD" & i)
           
           
            revisedsalary1 = ThisWorkbook.Sheets(1).Range("D" & i)
            revisedsalary2 = ThisWorkbook.Sheets(1).Range("G" & i)
            revisedsalary3 = ThisWorkbook.Sheets(1).Range("J" & i)
            revisedsalary4 = ThisWorkbook.Sheets(1).Range("M" & i)
            revisedsalary5 = ThisWorkbook.Sheets(1).Range("P" & i)
            revisedsalary6 = ThisWorkbook.Sheets(1).Range("S" & i)
            revisedsalary7 = ThisWorkbook.Sheets(1).Range("V" & i)
            revisedsalary8 = ThisWorkbook.Sheets(1).Range("Y" & i)
            revisedsalary9 = ThisWorkbook.Sheets(1).Range("AB" & i)
            revisedsalary10 = ThisWorkbook.Sheets(1).Range("AE" & i)
           
           
insertquery = "insert EmpAppraisal([Employee ID], [Appraisal/Increment Date1],[Last Salary1],[Revised Salary1],[Appraisal/Increment Date2],[Last Salary2],[Revised Salary2],[Appraisal/Increment Date3],[Last Salary3],[Revised Salary3],[Appraisal/Increment Date4],[Last Salary4],[Revised Salary4],[Appraisal/increment Date5],[Last Salary5],[Revised Salary5],[Appraisal/increment Date6],[Last Salary6],[Revised Salary6],[Appraisal/increment Date7],[Last Salary7],[Revised Salary7],[Appraisal/increment Date8],[Last Salary8],[Revised Salary8],[Appraisal/increment Date9],[Last Salary9],[Revised Salary9],[Appraisal/increment Date10],[Last Salary10],[Revised Salary10])" _
& "values('" & empId & "','" & apprisaldate1 & "','" & lastsalary1 & "','" & revisedsalary1 & "','" & apprisaldate2 & "','" & lastsalary2 & "','" & revisedsalary2 & "','" & apprisaldate3 & "','" & lastsalary3 & "','" & revisedsalary3 & "','" & apprisaldate4 & "','" & lastsalary4 & "','" & revisedsalary4 & "','" & apprisaldate5 & "','" & lastsalary5 & "','" & revisedsalary5 & "','" & apprisaldate6 & "'," _
& "'" & lastsalary6 & "','" & revisedsalary6 & "','" & apprisaldate7 & "','" & lastsalary7 & "','" & revisedsalary7 & "','" & apprisaldate8 _
& "','" & lastsalary8 & "','" & revisedsalary8 & "','" & apprisaldate9 & "','" & lastsalary9 & "','" & revisedsalary9 & "','" & apprisaldate10 & "','" & lastsalary10 & "','" & revisedsalary10 & "');"
            'ThisWorkbook.Sheets(1).Range("B4") = insertquery
            conn.Execute (insertquery)
           
   
   
    End If
  
   
       
    Next
     
           
           
       
        'End If
 'Next
End Sub


Download File