Next Chapter 57 Select Company
PROJECT SOURCE CODE
SPONSORED LINKS
Select Company
Dim CompRst As New ADODB.Recordset
Private Sub CancelCmd_Click()
' Call UnloadApplication
Unload Me
End Sub
Private Sub CompList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With CompList
.SortKey = ColumnHeader.Index - 1
.SortOrder = IIf(.SortOrder = lvwAscending, lvwDescending, lvwAscending)
.Sorted = True
End With
End Sub
Private Sub CompList_DblClick()
Call OKCmd_Click
End Sub
Private Sub Form_Load()
Dim CmdTxt, F As String
Dim SQL As String
Dim DBPath, ConnString As String
CmdTxt = Command$
Set fso = New Scripting.FileSystemObject
If Not CmdTxt = "/reg" Then GoTo BottomLbl
BottomLbl:
Set Conn = New ADODB.Connection
CompRst.CursorLocation = adUseClient
ConnString = "Provider=SQLOLEDB.1;Password=samee;Persist Security Info=True;User ID=samee;Initial Catalog=Companies; Data Source=" & ServerName & " "
Conn.Open ConnString
SQL = "SELECT Company.CompCode, Company.Company, Company.Address1, Company.Address2, Company.Address3, Company.LAV, Company.LstNo, Company.LstNo, Company.LstDate, Company.CstNo, Company.CstDate, Company.Ph_O, Company.Ph_R, Company.ContactPerson, Company.Fax, Company.Email, Company.Website, Company.Terms1, Company.Terms2, Company.Terms3, Comp_Year.FromDate, Comp_Year.ToDate FROM Company RIGHT JOIN Comp_Year ON Company.CompCode = Comp_Year.CompCode Order By Comp_Year.FromDate"
CompRst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
Call PopulateCompanies(CompRst)
End Sub
Private Sub PopulateCompanies(ByVal rst As ADODB.Recordset)
Dim CompItem As ListItem
With CompList
.ColumnHeaders(1).Width = 4649.95
.ColumnHeaders(2).Width = 1050
.ColumnHeaders(3).Width = 1050
.ColumnHeaders(4).Width = 0
.ColumnHeaders(5).Width = 0
.ColumnHeaders(6).Width = 0
Do Until rst.EOF
.View = lvwReport
If (Not rst!LAV) Or AdminUser Then 'If Not Hidden Company then Shown in list
With .ListItems.Add(, , rst!Company)
.ListSubItems.Add , , Format(rst!FromDate, "dd-mm-yyyy")
.ListSubItems.Add , , Format(rst!ToDate, "dd-mm-yyyy")
'Database file naming scheam
.ListSubItems.Add , , "Database" & CStr(rst!CompCode & Format(rst!FromDate, "ddmmyyyy"))
.ListSubItems.Add , , Format(rst!FromDate, "mm/dd/yyyy")
.ListSubItems.Add , , Format(rst!ToDate, "mm/dd/yyyy")
End With
End If
rst.MoveNext
Loop
OKCmd.Enabled = (.ListItems.Count > 0)
End With
End Sub
Private Sub Form_Paint()
Dim SelectedIndex As Integer
'Select Last Selected Company
SelectedIndex = GetSetting(App.EXEName, "General", "SelectedCompany", 1)
If CompList.ListItems.Count >= SelectedIndex Then
CompList.ListItems(SelectedIndex).Selected = True
CompList.SetFocus
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'On Error Resume Next
ConnectString = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & UserName & ";Initial Catalog=" & SelectedDataFile & ";Data Source=" & ServerName & " "
ShapeConnectString = "Provider=MSDataShape.1;Persist Security Info=True;Data Source=" & ServerName & ";User ID=" & UserName & ";Password=" & Password & ";Initial Catalog=" & SelectedDataFile & ";Data Provider=SQLOLEDB.1"
Set Conn = New ADODB.Connection
Conn.Open ConnectString
DataEnvironment1.Connection1.ConnectionString = ConnectString
CompRst.Close
Set CompRst = Nothing
End Sub
Private Sub OKCmd_Click()
Dim CompCode, SQL As String
If Not CompList.SelectedItem Is Nothing Then
SaveSetting App.EXEName, "General", "SelectedCompany", CompList.SelectedItem.Index
SelectedDataFile = CompList.SelectedItem.SubItems(3)
CompCode = Mid(CompList.SelectedItem.SubItems(3), 9, 2)
SQL = "SELECT Company.CompCode, Company.Company, Company.Address1, Company.Address2, Company.Address3, Company.LAV, Company.LstNo, Company.LstNo, Company.LstDate, Company.CstNo, Company.CstDate, Company.Ph_O, Company.Ph_R, Company.ContactPerson, Company.Fax, Company.Email, Company.Website, Company.Terms1, Company.Terms2, Company.Terms3, Comp_Year.FromDate, Comp_Year.ToDate FROM Company RIGHT JOIN Comp_Year ON Company.CompCode = Comp_Year.CompCode " & _
"WHERE (Company.CompCode = '" & CompCode & "' AND Comp_Year.FromDate = '" & CompList.SelectedItem.SubItems(4) & "' AND Comp_Year.ToDate = '" & CompList.SelectedItem.SubItems(5) & "')"
If CompRst.State = adStateOpen Then CompRst.Close
CompRst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If CompRst.RecordCount <= 0 Then MsgBox "Couldn't get selected company information.", vbCritical, "Application Terminated": End
Call GetCompanyData(CompRst)
Call SetMenuItems
Unload Me
If Not Command$ = "/reg" Then
Set rst = New ADODB.Recordset
rst.Open "select count(*) from Hospital", Conn, adOpenDynamic, adLockBatchOptimistic
If Not rst.EOF And Not IsNull(rst.Fields(0)) Then
If rst.Fields(0) = Command$ Then MsgBox "Your Trial Time is Over ,Please Register Your Software " & vbCrLf & " Contact to Mr. Anoop Srivastava(Surendra Enterprises " & vbCrLf & vbCrLf & "*************** Thank you ********************": End
End If
End If
MDIForm1.Show
Else
If CompList.ListItems.Count > 0 Then
MsgBox "Please select any company.", vbExclamation
CompList.SetFocus
Else
MsgBox "No Company available.", vbExclamation
End If
End If
End Sub
Private Sub GetCompanyData(ByVal rst As ADODB.Recordset)
With SelectedCompany
.CompCode = rst!CompCode
.Company = IIf(IsNull(rst!Company), "", rst!Company)
.Address1 = IIf(IsNull(rst!Address1), "", rst!Address1)
.Address2 = IIf(IsNull(rst!Address2), "", rst!Address2)
.Address3 = IIf(IsNull(rst!Address3), "", rst!Address3)
.LAV = rst!LAV
MDIForm1.Caption = IIf(IsNull(rst!Company), "", rst!Company)
hos_name = IIf(IsNull(rst!Company), "", rst!Company)
hos_add = IIf(IsNull(rst!Address1), "", rst!Address1)
.LstNo = IIf(IsNull(rst!LstNo), "", rst!LstNo)
If Not IsNull(rst!LstDate) Then
.LstDate = rst!LstDate
End If
.CstNo = IIf(IsNull(rst!CstNo), "", rst!CstNo)
If Not IsNull(rst!CstDate) Then
.CstDate = rst!CstDate
End If
.Ph_O = IIf(IsNull(rst!Ph_O), "", rst!Ph_O)
.Ph_R = IIf(IsNull(rst!Ph_R), "", rst!Ph_R)
.Fax = IIf(IsNull(rst!Fax), "", rst!Fax)
.ContactPerson = IIf(IsNull(rst!ContactPerson), "", rst!ContactPerson)
.Email = IIf(IsNull(rst!Email), "", rst!Email)
.Website = IIf(IsNull(rst!Website), "", rst!Website)
.Terms1 = IIf(IsNull(rst!Terms1), "", rst!Terms1)
.Terms2 = IIf(IsNull(rst!Terms2), "", rst!Terms2)
.Terms3 = IIf(IsNull(rst!Terms3), "", rst!Terms3)
.FromDate = IIf(IsNull(rst!FromDate), Null, rst!FromDate)
.ToDate = IIf(IsNull(rst!ToDate), Null, rst!ToDate)
End With
End Sub