Any Excel sheet 's inherent Code that executes with its first time opening :
-------------------------
Private Sub Workbook_Open()
Call ProtectSheets
Sheets(LoginSheet).Select
Range("a1").Select
End Sub

The code used to Protect or rather Lock down the cells within the Sheets and its Vice Versa :

-------------------------
Public Sub ProtectSheets()
    Dim ws As Worksheet
      For Each ws In Worksheets
          If Not (ws.Name = "Login Details") Then
             ws.Protect "Password:=a", UserInterfaceOnly:=True
          End If
      Next
          'Sheets("Queries").Visible = 2
  End Sub

Public Sub UnProtectSheets()

     Dim ws As Worksheet
          For Each ws In Worksheets
              ws.Unprotect "Password:=a"
           Next
  End Sub

Establishing Db Connection From An excel sheet and Vice Versa:

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

Private Function OpenDBConnection(objCon, Server, db_Instance, UsrId, Passwd)
   Dim connectionvarStringing
     Set objCon = CreateObject("ADODB.Connection")
    connectionvarStringing = "Provider=SQLOLEDB;Server=" & Server & ";Trusted_Connection=No;Initial Catalog=" & db_Instance & ";User ID=" & UsrId & ";Password=" & Passwd & ";"
   objCon.Open connectionvarStringing
End Function

' Close DB connection
Private Function CloseDB(objCon)
   objCon.Close
   Set objCon = Nothing
End Function

Getting Column Number for any particular column name witihn a Sheet :


-------------------------
Private Function getColumnNumber(varStringColName, varStringSheet)
     Dim i
      Sheets(varStringSheet).Select
       For i = 1 To 1000
           If varStringComp(UCase(Cells(1, i).Value), UCase(varStringColName), 0) = 0 Then
               getColumnNumber = i
       Exit For
          End If
      Next
 End Function

A generalised query Executed to fetch DB - Query results herein returning a sngle value :

-------------------------
Private Function Getval(Query, objCon)
      Dim var, p, objRec1, lavarStringowden
      Set objRec1 = CreateObject("ADODB.Recordset")
        ''executing denominator query
         objRec1.CursorLocation = adUseClient
        objRec1.Open Query, objCon, adOpenStatic, adLockOptimistic
       'count of records retrieved for den query
       lavarStringowden = objRec1.RecordCount

  If Not (objRec1.EOF) Then
          'writing query results to an Excel sheet "Results_Den_Records" of the file "worksheetqtp.xls" in Datasheet path
                 p = objRec1.getrows(lavarStringowden, 0)
                  var = p(0, 0)
              'DataTable.ExportSheet FileName, SheetName
     Else
            var = "No Data"
      End If
        'cleaning up
         objRec1.Close
          Set objRec1 = Nothing
          Getval = var
 End Function

Code Segment Used To Clear The Contents From Sheets :

-------------------------
Private Sub RemoveContents_from_Sheets()
     Range("'" & OverallSheet & "'!A2:C30").ClearContents
     Range("'" & PDSheet & "'!A2:E50").ClearContents
     Range("'" & SMQSheet & "'!A2:E50").ClearContents
     Range("'" & ReleaseSheet & "'!A2:E30").ClearContents
     Range("'" & FunctionalSheet & "'!A2:E30").ClearContents
     Range("'" & WorkTypeSheet & "'!A2:E30").ClearContents
End Sub

User Input Via INput BOx and storing it into some Global Variables :

-------------------------
Private Function GetProjectId()
    Dim var
    Dim message, title
    Dim a
    message = "Enter Project Id"
    title = "Input Project id value"
 EnterInputValue:
     var = InputBox(message, title)
        If Not (IsNumeric(var)) Or var = "" Then
          a = MsgBox("Project Id value is not valid!" & vbCrLf & "Click Ok to enter valid Project Id OR" &    Lf & "Cancel to Exit", vbOKCancel, "Mandatory value")
       If a = vbOK Then
         GoTo EnterInputValue
      ElseIf a = vbCancel Then
          GetProjectId = ""
      'Exit Function
     End If
  End If
  GetProjectId = var
End Function

Selecting The First Cell in All sheets witihn a Excel Workbook except a particular one :

-------------------------
Private Sub selectFirstCell()
    Dim ws As Worksheet
     For Each ws In Worksheets
        If Not (ws.Name = "Queries") Then
          ws.Select
          ws.Range("A1").Select
        End If
     Next
    Sheets(LoginSheet).Select
 End Sub


Fetching Some values from Db with a connection varStringing Passed In As a Parameter :
-------------------------

Private Function FetchDates(connectionObject1)
    Dim varStringProjectId
    Dim varStringSheet
    Dim varStringQuery
    Dim ObjRecSet
    Dim rowCount, ColumnCount, a, b, p, i, j, ObjMsg

    varStringProjectId = GetProjectId()

   If varStringProjectId = "" Then
       NoRepDates = 0
   Exit Function
   End If

varStringQuery = "select distinct ReportingPeriodFromDate,ReportingPeriodToDate from dbo.MetricsCollectionPeriod where ProjectID ='" & varStringProjectId & "' and isdeleted='0'"
Set ObjRecSet = CreateObject("ADODB.RecordSet")

ObjRecSet.CursorLocation = adUseClient
ObjRecSet.Open varStringQuery, connectionObject1, adOpenStatic, adLockOptimistic

'count of records retrieved from the query
rowCount = ObjRecSet.RecordCount
'MsgBox rowCount
ColumnCount = ObjRecSet.fields.Count
' If no Reporting Dates are found Exit The Sub
If rowCount = 0 Then
NoRepDates = 0
ObjMsg = MsgBox("No Reporting dates available for the Project id: " & varStringProjectId, vbOKOnly, "Reporting Period")
Exit Function
Else
NoRepDates = 1
End If

If Not (ObjRecSet.EOF) Then
a = 1
ObjRecSet.MoveFirst
p = ObjRecSet.getrows()

a = 2
For i = 0 To (rowCount - 1)
   b = 2
      For j = 0 To (ColumnCount - 1)
          Sheets(OverallSheet).Cells(a, b).NumberFormat = "m/d/yyyy"
          Sheets(OverallSheet).Cells(a, b) = p(j, i)
          b = b + 1
     Next
     Sheets(OverallSheet).Cells(a, 1) = varStringProjectId
     a = a + 1
    Next

Else
    MsgBox "No data retrieved for the query! "
End If
Range("A2").Select
'cleaning up
ObjRecSet.Close
Set ObjRecSet = Nothing

End Function


Validation Of The DB Credentials as specified in The excel sheet :
-------------------------

Private Sub ValidateExcelDBDetails()
   Dim Server_Name, db_Instance, User_name, Password
   Dim connectionvarStringing, objCon
    Dim i
     i = 2
  While (Sheets(LoginSheet).Cells(i, 1) <> vbNullvarStringing)
    Server_Name = Sheets(LoginSheet).Cells(i, 1)
    db_Instance = Sheets(LoginSheet).Cells(i, 2)
    User_name = Sheets(LoginSheet).Cells(i, 3)
    Password = Sheets(LoginSheet).Cells(i, 4)
   Set objCon = CreateObject("ADODB.Connection")
    On Error Resume Next
     connectionvarStringing = "Provider=SQLOLEDB;Server=" & Server_Name & ";Trusted_Connection=No;Initial Catalog=" & db_Instance & ";User ID=" & User_name & ";Password=" & Password & ";"
    objCon.Open connectionvarStringing
   If Not (Err.Number = 0) Then
       MsgBox "Error Code : " & Err.Description
      ExitFlag = 0
    Exit Sub
   Else
   ExitFlag = 1
  End If
   On Error GoTo 0
   i = i + 1
  Wend
End Sub

0 comments:

Post a Comment

Note: Only a member of this blog may post a comment.