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