Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
PROJECT SOURCE CODE
SPONSORED LINKS
Company Form
'******************************************************************
'******************************************************************
'** Subject : Creating Or Modify Company Information
'** Date : Tuesday, January, 13, 2004
'** Modified : Tuesday, January, 20, 2004
'******************************************************************
'******************************************************************
Option Explicit
Public CompAddMode As Boolean
Public CompEditMode As Boolean
Public CompEmptyTable As Boolean
Dim CurrentDBConn As New ADODB.Connection
Dim CreateDBConn As New ADODB.Connection
Dim CompRst As ADODB.Recordset
Private Sub CancelCmd_Click()
Me.CompAddMode = False
Me.CompEditMode = False
Call SetControls
End Sub
Private Sub CPTxt_Validate(Cancel As Boolean)
CPTxt = StrConv(CPTxt, vbProperCase)
End Sub
Private Sub ExitCmd_Click()
If Not (Me.CompAddMode Or Me.CompEditMode) Then Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Dim SQL As String
Dim DBPath, ConnString As String
Label1(1).Caption = IIf(Me.CompAddMode, "Create Company", "Altering Company")
Me.Caption = Label1(1).Caption
ConnectString = Conn.ConnectionString
Set CreateDBConn = New ADODB.Connection
Set CompRst = New ADODB.Recordset
CompRst.CursorLocation = adUseClient
If Me.CompAddMode Then
FromDate = CDate("4/1/" & Year(Date))
ToDate = CDate("3/31/" & Year(Date) + 1)
End If
CurrentDBConn.Open ConnectString
DBPath = "Companies"
ConnString = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & UserName & ";Initial Catalog=Companies;Data Source=" & ServerName & " "
CreateDBConn.Open ConnString
CompRst.Open "COMPANY", CreateDBConn, adOpenKeyset, adLockOptimistic, adCmdTable
If CompRst.RecordCount > 0 Then
If Me.CompEditMode Then
CompRst.MoveFirst
CompRst.Find "COMPCODE = '" & SelectedCompany.CompCode & "'"
If CompRst.EOF Then
Me.CompEditMode = False
MsgBox "Invalid Company Code found.", vbCritical
Exit Sub
End If
Call SetFieldsValues
End If
Else
Me.CompEmptyTable = True
End If
Call SetControls
End Sub
Private Sub SetFieldsValues()
On Error GoTo ErHand
If Not CompRst.RecordCount > 0 Then Exit Sub
CompTxt = IIf(IsNull(CompRst!Company), "", CompRst!Company)
AddTxt1 = IIf(IsNull(CompRst!Address1), "", CompRst!Address1)
AddTxt2 = IIf(IsNull(CompRst!Address2), "", CompRst!Address2)
AddTxt3 = IIf(IsNull(CompRst!Address3), "", CompRst!Address3)
HidChk.Value = Abs(CInt(CompRst!LAV))
txtLST = IIf(IsNull(CompRst!LstNo), "", CompRst!LstNo)
dtLst = IIf(IsNull(CompRst!LstDate), "", CompRst!LstDate)
txtCSTNo = IIf(IsNull(CompRst!CstNo), "", CompRst!CstNo)
DtCst = IIf(IsNull(CompRst!CstDate), "", CompRst!CstDate)
PhOTxt = IIf(IsNull(CompRst!Ph_O), "", CompRst!Ph_O)
Ph_RTxt = IIf(IsNull(CompRst!Ph_R), "", CompRst!Ph_R)
FaxTxt = IIf(IsNull(CompRst!Fax), "", CompRst!Fax)
CPTxt = IIf(IsNull(CompRst!ContactPerson), "", CompRst!ContactPerson)
MailTxt = IIf(IsNull(CompRst!Email), "", CompRst!Email)
WebTxt = IIf(IsNull(CompRst!Website), "", CompRst!Website)
Note1Txt = IIf(IsNull(CompRst!Terms1), "", CompRst!Terms1)
Note2Txt = IIf(IsNull(CompRst!Terms2), "", CompRst!Terms2)
Note3Txt = IIf(IsNull(CompRst!Terms3), "", CompRst!Terms3)
FromDate.Value = SelectedCompany.FromDate
ToDate.Value = SelectedCompany.ToDate
ErHand:
ErrHandler "CompFrm.SetFieldsValues()"
End Sub
Private Sub SetControls()
'MsgBox Me.CompEditMode & vbCr & CompFrm.CompEditMode
CompFrame.Enabled = (Me.CompAddMode Or Me.CompEditMode)
FooterFrame.Enabled = (Me.CompAddMode Or Me.CompEditMode)
SaveCmd.Enabled = (Me.CompAddMode Or Me.CompEditMode)
CancelCmd.Enabled = (Me.CompAddMode Or Me.CompEditMode)
CancelCmd.Cancel = (Me.CompAddMode Or Me.CompEditMode)
ExitCmd.Enabled = Not (Me.CompAddMode Or Me.CompEditMode)
ExitCmd.Cancel = Not (Me.CompAddMode Or Me.CompEditMode)
Label8(1).Enabled = Me.CompAddMode
Label8(2).Enabled = Me.CompAddMode
FromDate.Enabled = Me.CompAddMode
ToDate.Enabled = Me.CompAddMode
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Cancel = (SaveCmd.Enabled Or CancelCmd.Enabled)
End Sub
Private Sub SaveCmd_Click()
Dim SQL, C_Code As String
If Trim(CompTxt) = "" Then
MsgBox "Please, Input Company Name, this field could not be blank.", vbCritical
CompTxt.SetFocus
Exit Sub
ElseIf Trim(CPTxt) = "" Then
MsgBox "Please, Input Contact Person Name, this field could not be blank.", vbCritical
CPTxt.SetFocus
Exit Sub
ElseIf FromDate = "" Or ToDate = "" Then
MsgBox "Either From Date or To Date field is blank. These dates are required to creating new company. Please enter From Date or To Date value.", vbCritical
FromDate.SetFocus
Exit Sub
End If
Screen.MousePointer = vbHourglass
CreateDBConn.BeginTrans
If Me.CompAddMode Then
CompRst.AddNew
C_Code = GetCompanyCode
CompRst!CompCode = C_Code
End If
CompRst!Company = CompTxt
CompRst!Address1 = AddTxt1
CompRst!Address2 = AddTxt2
CompRst!Address3 = AddTxt3
CompRst!LAV = CBool(HidChk.Value)
CompRst!LstNo = txtLST
CompRst!LstDate = IIf(dtLst = "", Null, dtLst)
CompRst!CstNo = txtCSTNo
CompRst!CstDate = IIf(DtCst = "", Null, DtCst)
CompRst!Ph_O = PhOTxt
CompRst!Ph_R = Ph_RTxt
CompRst!Fax = FaxTxt
CompRst!ContactPerson = CPTxt
CompRst!Email = MailTxt
CompRst!Website = WebTxt
CompRst!Terms1 = Note1Txt
CompRst!Terms2 = Note2Txt
CompRst!Terms3 = Note3Txt
CompRst.Update
If Me.CompAddMode Then
SQL = "INSERT INTO COMP_YEAR VALUES ('" & C_Code & "', '" & FromDate.Value & "', '" & ToDate.Value & "')"
CreateDBConn.Execute SQL, , adCmdText
Me.CompEmptyTable = False
If Not CreateNewDatabase(C_Code, FromDate.Value) Then
'If new database is fail to create then rollback transactions
Me.CompAddMode = False
Me.CompEditMode = False
Call SetControls
CreateDBConn.RollbackTrans
Exit Sub
End If
End If
CreateDBConn.CommitTrans
Me.CompAddMode = False
Me.CompEditMode = False
Call SetControls
Screen.MousePointer = vbDefault
End Sub
Private Function GetCompanyCode() As String
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open "Select Max(convert(int,COMPCODE)) From COMPANY", CreateDBConn, adOpenForwardOnly, adLockReadOnly
GetCompanyCode = GetProperCode(IIf(IsNull(rst(0)), "1", rst(0) + 1), 2)
End Function
Private Function CreateNewDatabase(ByVal CompanyCode As String, ByVal FDate As Date) As Boolean
Dim i As Integer
Dim DBname As String
On Error GoTo ErHand
Dim CreateDBConn As New ADODB.Connection
i = 0
If CompanyCode = "" Then
MsgBox "Company Code is not available to creating new database.", vbCritical
CreateNewDatabase = False
Exit Function
End If
DBname = "Database" & CStr(CompanyCode & Format(FDate, "ddmmyyyy")) & ""
Set CreateDBConn = New ADODB.Connection
CreateDBConn.ConnectionString = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & UserName & ";Initial Catalog=" & SelectedDataFile & ";Data Source=" & ServerName & " "
CreateDBConn.Open
CreateDBConn.Execute "use " & SelectedDataFile & " Backup database " & SelectedDataFile & " to disk='c:\" & SelectedDataFile & ".dmp'"
CreateDBConn.Execute "use " & SelectedDataFile & " RESTORE FILELISTONLY FROM disk='c:\" & SelectedDataFile & ".dmp'"
CreateDBConn.Execute "use " & SelectedDataFile & " RESTORE DATABASE " & DBname & " FROM disk='c:\" & SelectedDataFile & ".dmp'" _
& " WITH Replace," _
& " Move '" & SelectedDataFile & "_Dat' TO 'C:\MSSQL7\Data\" & DBname & "_dat.mdf', " _
& " Move '" & SelectedDataFile & "_Log' TO 'C:\MSSQL7\Data\" & DBname & "_Log.ldf' "
Call DoBlankDatabase(DBname)
CreateNewDatabase = True
Exit Function
ErHand:
ErrHandler "CompFrm.CreateNewDatabase()"
'CreateDBConn.Execute "Drop DATABASE " & DBname
CreateNewDatabase = False
End Function
Sponsored Links