Hi,
We are trying to create a web-based project which can generate the a report from a database.
Now that we already have the excel macro written in VB module which generates the code. When we try to implement in web-based the same VB code is not working in VB.net! Is there anyway we can use the same code or should we add any component to VB.net to accept the existing VB module code.
Find my Vb module code wriiten in excel macro
Option Explicit
Dim oCon, oRS
Dim ConnStr As String
Dim StartDate As String, EndDate As String
Private Function Authenticate() As String
On Error GoTo Ent
Set oRS = oCon.Execute("SELECT profile FROM ams_employee WHERE e_code='" & UserName.Text & "' and password ='" & Password.Text & "'")
If oRS.EOF Then Authenticate = "User ID or Password error!": Exit Function
Set oRS = oCon.Execute("SELECT * FROM ams_profile WHERE profile='" & oRS(0) & "' AND profile_rights='HRS'")
If Not oRS.EOF Then Authenticate = "OK" Else Authenticate = "This user profile doesn't have sufficient rights to run this report." & vbCrLf & "Please contact administrator to request any changes."
Exit Function
Ent:
MsgBox "Authentication failed due to the following error:" & vbCrLf & Err.Description, vbCritical, "Error"
End Function
Private Sub Cancel_Click()
Unload Login
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Private Sub cmdGReport_Click()
On Error GoTo Ent
Dim iIndex As Integer
Dim iField As Integer
Dim iDayCnt As Integer
Dim iDay As Integer
Dim iLT As Integer
Dim sQ As String
Dim oRSL
Dim sLT(3): sLT(1) = "F": sLT(2) = "C": sLT(3) = "P"
ManipulateInputs
Set oCon = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
Dim oRSDet: Set oRSDet = CreateObject("ADODB.Recordset")
oCon.Open ConnStr
Dim AuthStat As String: AuthStat = Authenticate
If AuthStat = "OK" Then
Report.Unprotect "ams007"
Login.Hide
Report.Cells.Clear
Report.Cells.Font.Size = 8
Report.Range("A2:F2").Select
With Selection
.Merge
.Value = "eFunds International India Pvt.Ltd"
.Font.ColorIndex = 32
.Font.Bold = True
.Font.Size = 12
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A5:F5").Select
With Selection
.Merge
.Value = "Report Generated by Attendance Management System on " & Now
.Font.ColorIndex = 26
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A6:F6").Select
With Selection
.Merge
.Value = "Payroll Input for the Period " & StartDate & " - " & EndDate
.Font.ColorIndex = 53
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A1:F7").Select
Selection.Interior.ColorIndex = 2
iIndex = 8
Report.Range("A8:F8").Select
With Selection
.Font.ColorIndex = 25
.Interior.ColorIndex = 24
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Cells(iIndex, 1) = "E Code": Report.Columns(1).ColumnWidth = 10
Report.Cells(iIndex, 2) = "Name": Report.Columns(2).ColumnWidth = 30
Report.Cells(iIndex, 3) = "From Date": Report.Columns(3).ColumnWidth = 15
Report.Cells(iIndex, 4) = "To Date": Report.Columns(4).ColumnWidth = 15
Report.Cells(iIndex, 5) = "# Days": Report.Columns(5).ColumnWidth = 8
Report.Cells(iIndex, 6) = "Type": Report.Columns(6).ColumnWidth = 25
iIndex = iIndex + 1
' sQ = "SELECT e_code, a.leave_id, b.leave_type FROM ams_leave_reason a, ams_leave_trans b WHERE a.leave_id=b.leave_id AND b.leave_date>='" & DateSerial(Year(Date), Month(Date), 1) & "' AND b.leave_date<='" & DateSerial(Year(Date), Month(Date) + 1, 0) & "'"
sQ = "SELECT e_code, e_name FROM ams_employee"
Set oRS = oCon.Execute(sQ)
Dim NoOfDays As Double
Dim LeaveType As String
While Not oRS.EOF
sQ = "SELECT leave_id FROM ams_leave_reason WHERE e_code='" & oRS(0) & "' AND leave_status='A' AND start_date>='" & StartDate & "' AND start_date<='" & EndDate & "'"
Set oRSL = oCon.Execute(sQ)
While Not oRSL.EOF
sQ = "SELECT leave_type FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Select Case Right(oRSDet(0), 1)
Case "C", "P", "F"
LeaveType = "General"
Case "L"
LeaveType = "LOP"
Case "A"
LeaveType = "Card not shown"
Case "O"
LeaveType = "On Duty"
Case "X"
GoTo SkipThisID
Case Else
LeaveType = "Leave: " & oRSDet(0)
End Select
If LeaveType = "General" Then
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A')"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
For iLT = 1 To 3
If iLT = 1 Then
LeaveType = "Comp Off"
ElseIf iLT = 2 Then
LeaveType = "CL"
ElseIf iLT = 3 Then
LeaveType = "PL"
End If
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A') AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D' AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
If oRSDet(0) <> "" And oRSDet(1) <> "" Then
Report.Range(Report.Cells(iIndex, 1), Report.Cells(iIndex, 6)).Select
With Selection
.Interior.ColorIndex = 15
End With
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
End If
Next
Else
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A')"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
End If
SkipThisID:
DoEvents
oRSL.MoveNext
Wend
oRS.MoveNext
Wend
Report.Cells(1, 1).Select
Else
MsgBox AuthStat, vbExclamation
Unload Login
End If
Report.Protect "ams007", True, True, True
Exit Sub
Ent:
MsgBox "Report Generation aborted due to the following error:" & vbCrLf & Err.Description, vbCritical, "Error"
End
End Sub
Function CodeToName(ECode)
Dim objRs, sqlstr1
sqlstr1 = "select e_name from ams_employee where e_code = '" & ECode & "'"
Set objRs = oCon.Execute(sqlstr1)
If Not objRs.EOF Then
TeamLeader = objRs("e_name")
Else
TeamLeader = "Not Known"
End If
Set objRs = Nothing
End Function
Private Sub cmdGReport_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
End Sub
Private Sub UserForm_Activate()
FillCombo cmbFDD, "DD", "1"
FillCombo cmbFMM, "MM", MonthName(Month(Date), True)
FillCombo cmbFYYYY, "YYYY", CStr(Year(Date))
FillCombo cmbTDD, "DD", CStr(Day(DateSerial(Year(Date), Month(Date) + 1, 0)))
FillCombo cmbTMM, "MM", MonthName(Month(Date), True)
FillCombo cmbTYYYY, "YYYY", CStr(Year(Date))
FillComboMisc
End Sub
Private Sub FillComboMisc()
cmbLocation.AddItem "Chennai"
'cmbLocation.AddItem "Mumbai"
'cmbLocation.Text = "Gurgaon"
End Sub
Private Sub FillCombo(Cmb As Object, ToFill As String, Optional Def As String)
Dim iCnt As Integer
Select Case ToFill
Case "DD"
For iCnt = 1 To 31
Cmb.AddItem CStr(iCnt)
Cmb.Text = Def
Next
Case "MM"
For iCnt = 1 To 12
Cmb.AddItem MonthName(iCnt, True)
Cmb.Text = Def
Next
Case "YYYY"
For iCnt = 2002 To Year(Date) + 1
Cmb.AddItem CStr(iCnt)
Cmb.Text = Def
Next
End Select
End Sub
Private Sub ManipulateInputs()
Select Case cmbLocation.Text
Case "Chennai"
ConnStr = "Server=10.164.112.57;Provider=SQLOLEDB;Database=amsindia;UID=ams_web;password=12344"
'Case "Mumbai"
'ConnStr = "Server=172.21.7.239;Provider=SQLOLEDB;Database=amsindia;UID=ams_web;password=12344"
Case Else
MsgBox "Invalid Location!", vbExclamation, "Error"
End
End Select
StartDate = cmbFDD.Text & " " & cmbFMM.Text & " " & cmbFYYYY.Text
EndDate = cmbTDD.Text & " " & cmbTMM.Text & " " & cmbTYYYY.Text
End Sub
The above code is wriiten in excel macro to generate the report. Same code is not working in .net
Can some one help.
We are trying to create a web-based project which can generate the a report from a database.
Now that we already have the excel macro written in VB module which generates the code. When we try to implement in web-based the same VB code is not working in VB.net! Is there anyway we can use the same code or should we add any component to VB.net to accept the existing VB module code.
Find my Vb module code wriiten in excel macro
Option Explicit
Dim oCon, oRS
Dim ConnStr As String
Dim StartDate As String, EndDate As String
Private Function Authenticate() As String
On Error GoTo Ent
Set oRS = oCon.Execute("SELECT profile FROM ams_employee WHERE e_code='" & UserName.Text & "' and password ='" & Password.Text & "'")
If oRS.EOF Then Authenticate = "User ID or Password error!": Exit Function
Set oRS = oCon.Execute("SELECT * FROM ams_profile WHERE profile='" & oRS(0) & "' AND profile_rights='HRS'")
If Not oRS.EOF Then Authenticate = "OK" Else Authenticate = "This user profile doesn't have sufficient rights to run this report." & vbCrLf & "Please contact administrator to request any changes."
Exit Function
Ent:
MsgBox "Authentication failed due to the following error:" & vbCrLf & Err.Description, vbCritical, "Error"
End Function
Private Sub Cancel_Click()
Unload Login
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Private Sub cmdGReport_Click()
On Error GoTo Ent
Dim iIndex As Integer
Dim iField As Integer
Dim iDayCnt As Integer
Dim iDay As Integer
Dim iLT As Integer
Dim sQ As String
Dim oRSL
Dim sLT(3): sLT(1) = "F": sLT(2) = "C": sLT(3) = "P"
ManipulateInputs
Set oCon = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
Dim oRSDet: Set oRSDet = CreateObject("ADODB.Recordset")
oCon.Open ConnStr
Dim AuthStat As String: AuthStat = Authenticate
If AuthStat = "OK" Then
Report.Unprotect "ams007"
Login.Hide
Report.Cells.Clear
Report.Cells.Font.Size = 8
Report.Range("A2:F2").Select
With Selection
.Merge
.Value = "eFunds International India Pvt.Ltd"
.Font.ColorIndex = 32
.Font.Bold = True
.Font.Size = 12
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A5:F5").Select
With Selection
.Merge
.Value = "Report Generated by Attendance Management System on " & Now
.Font.ColorIndex = 26
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A6:F6").Select
With Selection
.Merge
.Value = "Payroll Input for the Period " & StartDate & " - " & EndDate
.Font.ColorIndex = 53
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Range("A1:F7").Select
Selection.Interior.ColorIndex = 2
iIndex = 8
Report.Range("A8:F8").Select
With Selection
.Font.ColorIndex = 25
.Interior.ColorIndex = 24
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Report.Cells(iIndex, 1) = "E Code": Report.Columns(1).ColumnWidth = 10
Report.Cells(iIndex, 2) = "Name": Report.Columns(2).ColumnWidth = 30
Report.Cells(iIndex, 3) = "From Date": Report.Columns(3).ColumnWidth = 15
Report.Cells(iIndex, 4) = "To Date": Report.Columns(4).ColumnWidth = 15
Report.Cells(iIndex, 5) = "# Days": Report.Columns(5).ColumnWidth = 8
Report.Cells(iIndex, 6) = "Type": Report.Columns(6).ColumnWidth = 25
iIndex = iIndex + 1
' sQ = "SELECT e_code, a.leave_id, b.leave_type FROM ams_leave_reason a, ams_leave_trans b WHERE a.leave_id=b.leave_id AND b.leave_date>='" & DateSerial(Year(Date), Month(Date), 1) & "' AND b.leave_date<='" & DateSerial(Year(Date), Month(Date) + 1, 0) & "'"
sQ = "SELECT e_code, e_name FROM ams_employee"
Set oRS = oCon.Execute(sQ)
Dim NoOfDays As Double
Dim LeaveType As String
While Not oRS.EOF
sQ = "SELECT leave_id FROM ams_leave_reason WHERE e_code='" & oRS(0) & "' AND leave_status='A' AND start_date>='" & StartDate & "' AND start_date<='" & EndDate & "'"
Set oRSL = oCon.Execute(sQ)
While Not oRSL.EOF
sQ = "SELECT leave_type FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Select Case Right(oRSDet(0), 1)
Case "C", "P", "F"
LeaveType = "General"
Case "L"
LeaveType = "LOP"
Case "A"
LeaveType = "Card not shown"
Case "O"
LeaveType = "On Duty"
Case "X"
GoTo SkipThisID
Case Else
LeaveType = "Leave: " & oRSDet(0)
End Select
If LeaveType = "General" Then
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A')"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
For iLT = 1 To 3
If iLT = 1 Then
LeaveType = "Comp Off"
ElseIf iLT = 2 Then
LeaveType = "CL"
ElseIf iLT = 3 Then
LeaveType = "PL"
End If
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A') AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D' AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_type LIKE '_" & sLT(iLT) & "'"
Set oRSDet = oCon.Execute(sQ)
If oRSDet(0) <> "" And oRSDet(1) <> "" Then
Report.Range(Report.Cells(iIndex, 1), Report.Cells(iIndex, 6)).Select
With Selection
.Interior.ColorIndex = 15
End With
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
End If
Next
Else
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part IN ('F','A')"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = oRSDet(0) / 2
sQ = "SELECT Count(*) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "' AND leave_part='D'"
Set oRSDet = oCon.Execute(sQ)
NoOfDays = NoOfDays + oRSDet(0)
sQ = "SELECT min(leave_date), max(leave_date) FROM ams_leave_trans WHERE leave_id='" & oRSL(0) & "'"
Set oRSDet = oCon.Execute(sQ)
Report.Cells(iIndex, 1) = oRS(0)
Report.Cells(iIndex, 2) = oRS(1)
Report.Cells(iIndex, 3) = FormatDateTime(oRSDet(0), vbShortDate)
Report.Cells(iIndex, 4) = FormatDateTime(oRSDet(1), vbShortDate)
Report.Cells(iIndex, 5) = NoOfDays
Report.Cells(iIndex, 6) = LeaveType
iIndex = iIndex + 1
End If
SkipThisID:
DoEvents
oRSL.MoveNext
Wend
oRS.MoveNext
Wend
Report.Cells(1, 1).Select
Else
MsgBox AuthStat, vbExclamation
Unload Login
End If
Report.Protect "ams007", True, True, True
Exit Sub
Ent:
MsgBox "Report Generation aborted due to the following error:" & vbCrLf & Err.Description, vbCritical, "Error"
End
End Sub
Function CodeToName(ECode)
Dim objRs, sqlstr1
sqlstr1 = "select e_name from ams_employee where e_code = '" & ECode & "'"
Set objRs = oCon.Execute(sqlstr1)
If Not objRs.EOF Then
TeamLeader = objRs("e_name")
Else
TeamLeader = "Not Known"
End If
Set objRs = Nothing
End Function
Private Sub cmdGReport_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
End Sub
Private Sub UserForm_Activate()
FillCombo cmbFDD, "DD", "1"
FillCombo cmbFMM, "MM", MonthName(Month(Date), True)
FillCombo cmbFYYYY, "YYYY", CStr(Year(Date))
FillCombo cmbTDD, "DD", CStr(Day(DateSerial(Year(Date), Month(Date) + 1, 0)))
FillCombo cmbTMM, "MM", MonthName(Month(Date), True)
FillCombo cmbTYYYY, "YYYY", CStr(Year(Date))
FillComboMisc
End Sub
Private Sub FillComboMisc()
cmbLocation.AddItem "Chennai"
'cmbLocation.AddItem "Mumbai"
'cmbLocation.Text = "Gurgaon"
End Sub
Private Sub FillCombo(Cmb As Object, ToFill As String, Optional Def As String)
Dim iCnt As Integer
Select Case ToFill
Case "DD"
For iCnt = 1 To 31
Cmb.AddItem CStr(iCnt)
Cmb.Text = Def
Next
Case "MM"
For iCnt = 1 To 12
Cmb.AddItem MonthName(iCnt, True)
Cmb.Text = Def
Next
Case "YYYY"
For iCnt = 2002 To Year(Date) + 1
Cmb.AddItem CStr(iCnt)
Cmb.Text = Def
Next
End Select
End Sub
Private Sub ManipulateInputs()
Select Case cmbLocation.Text
Case "Chennai"
ConnStr = "Server=10.164.112.57;Provider=SQLOLEDB;Database=amsindia;UID=ams_web;password=12344"
'Case "Mumbai"
'ConnStr = "Server=172.21.7.239;Provider=SQLOLEDB;Database=amsindia;UID=ams_web;password=12344"
Case Else
MsgBox "Invalid Location!", vbExclamation, "Error"
End
End Select
StartDate = cmbFDD.Text & " " & cmbFMM.Text & " " & cmbFYYYY.Text
EndDate = cmbTDD.Text & " " & cmbTMM.Text & " " & cmbTYYYY.Text
End Sub
The above code is wriiten in excel macro to generate the report. Same code is not working in .net
Can some one help.
