Run-time error 383. 'Text' property is readonly

[Lalit2015]

thread222-1132994

Hi,

Currently we are using Visual Basic 6.0 and SQL 2005 and build the application.[URL unfurl="true"]https://res.cloudinary.com/engineering-com/raw/upload/v1434346615/tips/Run_Time_Error_ihkdg8.docx[/url]
Our application working from last 4 year without any problem.

We install this application at all our User's PC and working well.

This application working on all Windows XP system perfectly but suddenly we get this error message.

RUN TIME ERROR '383'
'Text' Property is read only.


I am attaching document for your reference.

I don't think that this is because of error of code because we didn't touch the code.

We just create an Item and entry purpose .

Is there any solution can you please help us to get recover.

We did code level test but nothing find out .

Looking for your positive reply.

Regards,
Lalit.

 

[Andrzejek]

There is no attachment to your post, at least I cannot see one.
But I would include the offending code here in your post (please use TGML tags to show your code) and point to the line that creates the error.

Some code here[red]
    line with the error[/red] 
some more code

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[strongm]

The attachment was just screen shots.

 

[Lalit2015]

Hi ,

But I attached my screen shot .
I am having the following code for that application.

Earlier it happens in 17 Dec 2014 but than I leave as it is because I did all the testing and could of days it recover automatically.
But This time It comes again .

I am really surprise with this error.

Actully When I go with the menu (Master-> Item Master-> Wide Coils)
after that it did not load my form as code below:

Private Sub mnuWideCoilsItemMaster_Click()
frmWideCoilsMaster.Show
End Sub

Even when I open the code of this form : (Picture Attached)

and contain the codes are below:
Option Explicit
Dim blnSearchingFromBeginning As Boolean
Dim blnEditMode As Boolean, blnAddMode As Boolean
Dim CurrentNode As Node
Dim rsData As New ADODB.Recordset

Private Sub cmdDelete_Click()

If Val(txtAliasName.Tag) > 0 Then
MsgBox "HadleyIS built in item or Group!!" & Chr(13) & _
"You are not allowed to delete...", vbExclamation, App.Title
Exit Sub
Else
Dim rsEntry As New ADODB.Recordset
If rsEntry.State = adStateOpen Then rsEntry.Close
rsEntry.Open "Select top 1 ItemID from HISPurchaseDetails " & _
"Where ItemID = " & Val(txtItemName.Tag), _
HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsEntry.RecordCount > 0 Then
MsgBox "Cannot Delete " & Trim(txtItemName.Text) & ". Active Purchase Entries found.", vbInformation, App.Title
tvItems.SetFocus
Exit Sub
Else
Dim intDeleteOk As Integer
intDeleteOk = MsgBox("You are about delete " & UCase(txtItemName.Text) & _
"!!" & Chr(13) & "Are you sure?", vbQuestion + vbYesNo, App.Title)
If intDeleteOk = 6 Then
If tvItems.SelectedItem.Children > 0 Then
MsgBox "Selected Item Group has Items!!" & Chr(13) & _
"Delete the Items and proceed...", vbExclamation, App.Title
Else
HadleyISCnn.BeginTrans

HadleyISCnn.Execute "Delete from Hisitem where companyid=" & _
HadleyISCompanyID & " and itemid=" & Val(txtItemName.Tag)

HadleyISCnn.Execute "Delete from HisITemOpeningstock where companyid=" & _
HadleyISCompanyID & " and Itemid=" & Val(txtItemName.Tag)


HadleyISCnn.CommitTrans
ItemGroupFilling
tvItems.Nodes.Remove (tvItems.SelectedItem.Key)
tvItems_NodeClick tvItems.SelectedItem
tvItems.SetFocus
End If
End If
End If
End If

End Sub

Private Sub cmdDone_Click()
Unload Me
End Sub

Private Sub cmdModify_Click()
If blnEditMode Then
If blnAddMode Then blnAddMode = False
blnEditMode = False
ClearFields
RefreshButtons
tvItems_NodeClick tvItems.SelectedItem
tvItems.SetFocus
Else
blnEditMode = True
RefreshButtons
txtItemName.SetFocus
End If
End Sub

Private Sub cmdNew_Click()
Dim rsDetails As New ADODB.Recordset
If blnEditMode Then

If Trim(txtItemName.Text) = "" Then
MsgBox "Invalid Name!!", vbExclamation, App.Title
txtItemName.SetFocus
Exit Sub
End If
' Changed
' If Val(HadleyISCurrentUserCategoryID) = 1 Then
' If optItemGroup.value = True Then
' MsgBox "User does't have rights Create a Group!!", vbInformation, App.Title
' Exit Sub
' End If
' End If
' If CategoryCombo.ItemData(CategoryCombo.ListIndex) = 0 Then
' If Val(HadleyISCurrentUserCategoryID) = 1 Then
' MsgBox "User does't have rights Create a Group!!", vbInformation, App.Title
' Exit Sub
' End If
' End If

Dim intITemID As Integer, intItemParent As Integer
Dim intItemRoot As Integer, intItemType As Integer
Dim txtInsertItem As String, txtInsertBalance As String
intItemRoot = 0
intItemParent = 0
If ItemGroup.ItemData(ItemGroup.ListIndex) = 0 Then 'Group is ROOT
intItemType = 1
intItemParent = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
intItemRoot = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
ElseIf optItemGroup.Value = True Then 'Category is Item Group
intItemType = 2
If chkItemCategory.Value = 1 Then 'is item Category
intItemParent = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
If rsDetails.State = adStateOpen Then rsDetails.Close
rsDetails.Open " Select itemParent From HisITem Where ItemID =" & _
Val(ItemGroup.ItemData(ItemGroup.ListIndex)), HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsDetails.RecordCount > 0 Then
intItemRoot = Val(rsDetails!ItemParent)
Else
intItemRoot = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
End If
Else
intItemParent = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
intItemRoot = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
End If

Else 'Category is Item
intItemType = 3
If Val(CategoryCombo.ItemData(CategoryCombo.ListIndex)) = 0 Then
intItemParent = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
intItemRoot = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
Else
intItemParent = Val(CategoryCombo.ItemData(CategoryCombo.ListIndex))
intItemRoot = Val(ItemGroup.ItemData(ItemGroup.ListIndex))
End If
End If


If blnAddMode Then
intITemID = GetSequence("HISSequenceItem")
txtItemName.Tag = intITemID

If intItemType = 3 Then
Dim rsItemParent As New ADODB.Recordset
If rsItemParent.State = adStateOpen Then rsItemParent.Close
rsItemParent.Open "Select ItemType from HISItem where ItemID = " & intItemParent, HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsItemParent.RecordCount > 0 Then
rsItemParent.MoveFirst
If rsItemParent!ItemType = 3 Then
MsgBox "Invalid Item Group Selection.", vbInformation, App.Title
tvItems.SetFocus
Exit Sub
End If
End If
End If

HadleyISCnn.Execute "Insert into HISItem (companyid,Itemid,Itemname,ItemCode,isItemCategory," & _
" Itemalias,Itemtype,Itemparent,Itemroot,ItemCategory,remarks,KeepingInventory,Gauge,GaugeUnitID,Width,WidthUnitID," & _
" Length,LengthUnitID,DefaultUnitID,ItemGroupID,StockCategoryID) values (" & _
HadleyISCompanyID & "," & intITemID & ",'" & Trim(Replace(txtItemName.Text, "'", "''")) & "','" & _
Trim(Replace(txtItemCode.Text, "'", "''")) & "'," & IIf(chkItemCategory.Value, 1, 0) & ",'" & _
Trim(Replace(txtAliasName.Text, "'", "''")) & "'," & Val(intItemType) & "," & Val(intItemParent) & _
"," & Val(intItemRoot) & "," & Val(CategoryCombo.ItemData(CategoryCombo.ListIndex)) & ",'" & Trim(Replace(txtRemarks.Text, "'", "''")) & _
"'," & IIf(chkInventory.Value, 1, 0) & "," & Val(txtGauge.Text) & "," & Val(GuageUnitCombo.ItemData(GuageUnitCombo.ListIndex)) & "," & _
Val(txtWidth.Text) & "," & Val(WidthUnitCombo.ItemData(WidthUnitCombo.ListIndex)) & "," & _
Val(txtLength.Text) & "," & Val(LengthUnitCombo.ItemData(LengthUnitCombo.ListIndex)) & "," & _
Val(UnitCombo.ItemData(UnitCombo.ListIndex)) & "," & Val(HadleyISWideCoilCategoryID) & "," & _
Val(StockCategory.ItemData(StockCategory.ListIndex)) & ")"

HadleyISCnn.Execute "Insert Into HISItemOpeningStock (CompanyId,FyearID,ItemID) Values (" & _
HadleyISCompanyID & "," & HadleyISFyearID & "," & intITemID & ")"



Select Case intItemType
Case 1, 2
tvItems.Nodes.Add "A" & Trim(str(intItemParent)), tvwChild, "A" & _
Trim(str(intITemID)), txtItemName.Text, 2
Case 3
tvItems.Nodes.Add "A" & Trim(str(intItemParent)), tvwChild, "A" & _
Trim(str(intITemID)), txtItemName.Text, 3
End Select

tvItems.Nodes.item("A" & Trim(str(intITemID))).EnsureVisible
tvItems.Nodes.item("A" & Trim(str(intITemID))).Selected = True
blnAddMode = False
'To Add The New Item Group To The ItemGroup Combo
If optItemGroup.Value = True Then
ItemGroupFilling
If intItemParent = 0 Then
ItemGroup.Text = "ROOT"
Else
ItemGroup.Text = tvItems.Nodes.item("A" & Trim(str(intItemParent))).Text
End If
End If
Else
If Val(txtAliasName.Tag) > 0 Then
MsgBox "HadleyIS built in Group or Item!!" & Chr(13) & _
"You are not allowed to modify it...", vbExclamation, App.Title
cmdModify_Click
Exit Sub
Else
HadleyISCnn.Execute "Update HISItem set Itemname='" & _
Trim(Replace(txtItemName.Text, "'", "''")) & "',Itemalias='" & Trim(Replace(txtAliasName.Text, "'", "''")) & _
"',ItemCode ='" & Trim(Replace(txtItemCode.Text, "'", "''")) & _
"',Itemtype=" & Val(intItemType) & ",ItemParent = " & Val(intItemParent) & _
",isItemCategory =" & IIf(chkItemCategory.Value, 1, 0) & _
",ItemRoot = " & Val(intItemRoot) & ",ITemCategory=" & Val(CategoryCombo.ItemData(CategoryCombo.ListIndex)) & _
",remarks='" & Trim(Replace(txtRemarks.Text, "'", "''")) & _
"',KeepingInventory =" & IIf(chkInventory.Value, 1, 0) & ",Gauge =" & Val(txtGauge.Text) & _
",length =" & Val(txtLength.Text) & ",Width =" & Val(txtWidth.Text) & ",GaugeUnitID =" & _
Val(GuageUnitCombo.ItemData(GuageUnitCombo.ListIndex)) & ",WidthUnitID =" & _
Val(WidthUnitCombo.ItemData(WidthUnitCombo.ListIndex)) & ",LengthUnitID =" & _
Val(LengthUnitCombo.ItemData(LengthUnitCombo.ListIndex)) & ",DefaUltUnitID =" & _
Val(UnitCombo.ItemData(UnitCombo.ListIndex)) & ",ItemGroupID =" & _
Val(HadleyISWideCoilCategoryID) & ", stockCategoryID =" & Val(StockCategory.ItemData(StockCategory.ListIndex)) & _
" Where Itemid =" & Val(txtItemName.Tag)

'
tvItems.SelectedItem.Text = Trim(txtItemName.Text)
Set tvItems.SelectedItem.Parent = tvItems.Nodes("A" & Trim(str(intItemParent)))
End If
End If
tvItems.Refresh
blnEditMode = False
RefreshButtons
Else
blnAddMode = True
blnEditMode = True
ClearFields
RefreshButtons
optItemGroup.SetFocus
End If
End Sub

Private Sub cmdSearch_Click()
On Error Resume Next
If blnSearchingFromBeginning = True Then
If rsData.State = adStateOpen Then rsData.Close
rsData.Open "select ItemID from HisItem Where " & Trim(dxPEField1.EditValue) & " like '" & _
Trim(txtSearch.Text) & "%' and ItemGroupID =" & Val(HadleyISWideCoilCategoryID) & "Order by ItemName", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsData.RecordCount > 0 Then
Set CurrentNode = tvItems.Nodes(1)
Do While Val(rsData!ItemID) <> Val(Mid(CurrentNode.Key, 2, 8))
If CurrentNode.Index = tvItems.Nodes.count Then
If blnSearchingFromBeginning = True Then
MsgBox "The search has examined all items. No more similar items found.", vbInformation, App.Title
blnSearchingFromBeginning = False
Exit Sub
End If
End If
'If CurrentNode.Index <= 2 Then blnSearchingFromBeginning = True
Set CurrentNode = tvItems.Nodes.item(CurrentNode.Index + 1)
Loop
CurrentNode.Selected = True
blnSearchingFromBeginning = False
tvItems_NodeClick CurrentNode
Else
MsgBox "The search has examined all items. No more similar items found.", vbInformation, App.Title
blnSearchingFromBeginning = False
End If
Else
If Not rsData.EOF Then
rsData.MoveNext
If Not rsData.EOF Then
Set CurrentNode = tvItems.Nodes.item(CurrentNode.Index + 1)
Do While Val(rsData!ItemID) <> Val(Mid(CurrentNode.Key, 2, 8))
If CurrentNode.Index = tvItems.Nodes.count Then
MsgBox "The search has examined all items. No more similar items found.", vbInformation, App.Title
blnSearchingFromBeginning = False
Exit Sub
End If
'If CurrentNode.Index <= 2 Then blnSearchingFromBeginning = True
If CurrentNode.Index <> tvItems.Nodes.count Then Set CurrentNode = tvItems.Nodes.item(CurrentNode.Index + 1)
Loop
Else
MsgBox "The search has examined all items. No more similar items found.", vbInformation, App.Title
End If
CurrentNode.Selected = True
tvItems_NodeClick CurrentNode
End If
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
SendKeys vbTab

Case 27
If MsgBox("You Are About To Close This Window. Are You Sure you want to continue...?", vbInformation + vbYesNo + vbDefaultButton2, App.Title) = vbYes Then
Unload Me
End If

Case Else
KeyAscii = Asc(UCase(Chr(KeyAscii)))

End Select

End Sub

Private Sub Form_Load()
Me.Move 0, 0
ItemGroupFilling
SetStockCategory
ItemCategoryFilling
SetUnitcategory
SetLengthUnitcategory
SelectItems
txtRemarks.Text = "Nil"
dxPEField1.EditValue = "ItemCode"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set frmItemMaster = Nothing
'frmMenu.dxSideBar1.Visible = False
End Sub
Private Sub RefreshButtons()
If blnEditMode Then
cmdNew.Caption = "&Save"
cmdModify.Caption = "&Cancel"
cmdDelete.Enabled = False
cmdDone.Enabled = False
cmdModify.Enabled = True
tvItems.Enabled = False
Frame4.Enabled = True
If blnAddMode Then
Frame2.Enabled = True
Else
Frame2.Enabled = False
End If
If optItem.Value = True Then
Frame5.Enabled = True
Else
Frame5.Enabled = False
End If
Else
cmdNew.Caption = "&New"
cmdModify.Caption = "&Modify"
cmdDelete.Enabled = True
cmdDone.Enabled = True
tvItems.Enabled = True
Frame4.Enabled = False
End If
End Sub
Private Sub SelectItems()
tvItems.Nodes.Add , , "A0", "Item Groups & Categories", 1
Dim rsGroups As New ADODB.Recordset
Dim rsItems As New ADODB.Recordset
Dim rsSubGroups As New ADODB.Recordset
Dim intAccID As Integer, AccNo As Integer
If rsGroups.State = adStateOpen Then rsGroups.Close
rsGroups.Open "Select ItemID, ItemName, ItemParent, ItemType" & _
" From HISItem Where Companyid=" & HadleyISCompanyID & " And ItemType =1 " & _
" and ItemId = " & Val(HadleyISWideCoilCategoryID) & " Order by ItemType,ItemID ", HadleyISCnn, adOpenStatic, adLockReadOnly
If rsGroups.RecordCount > 0 Then
intAccID = rsGroups!ItemID
Select Case rsGroups!ItemType
Case 1
tvItems.Nodes.Add "A0", tvwChild, "A" & Trim(str(rsGroups!ItemID)), rsGroups!ItemName, 2
Case 2
tvItems.Nodes.Add "A" & Trim(str(rsGroups!ItemParent)), tvwChild, "A" & Trim(str(rsGroups!ItemID)), rsGroups!ItemName, 2
End Select
End If
If rsSubGroups.State = adStateOpen Then rsSubGroups.Close
rsSubGroups.Open "Select ItemID, ItemName, ItemParent,ItemType from HISItem " & _
" Where CompanyID = 1 and ItemGroupID =" & Val(HadleyISWideCoilCategoryID) & _
" ORder by ItemID ", HadleyISCnn, adOpenStatic, adLockReadOnly
If rsSubGroups.RecordCount > 0 Then
Do While Not rsSubGroups.EOF
intAccID = rsSubGroups!ItemID
Select Case rsSubGroups!ItemType
Case 1
tvItems.Nodes.Add "A0", tvwChild, "A" & Trim(str(rsSubGroups!ItemID)), rsSubGroups!ItemName, 2
Case 2
tvItems.Nodes.Add "A" & Trim(str(rsSubGroups!ItemParent)), tvwChild, "A" & Trim(str(rsSubGroups!ItemID)), rsSubGroups!ItemName, 2
End Select
rsSubGroups.MoveNext
Loop
End If
If rsItems.State = adStateOpen Then rsItems.Close
rsItems.Open " Select ItemID, ItemName, ItemParent,ItemType from HISItem " & _
" Where CompanyID = " & HadleyISCompanyID & "AND ItemType =3 And ItemGroupid = " & Val(HadleyISWideCoilCategoryID) & _
" Order By ItemName", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsItems.RecordCount > 0 Then
Do While Not rsItems.EOF
Select Case rsItems!ItemType
Case 1
tvItems.Nodes.Add "A0", tvwChild, "A" & Trim(str(rsSubGroups!ItemID)), rsSubGroups!ItemName, 2
Case 2
tvItems.Nodes.Add "A" & Trim(str(rsSubGroups!ItemID)), tvwChild, "A" & Trim(str(rsItems!ItemID)), rsItems!ItemName, 2
Case 3
tvItems.Nodes.Add "A" & Trim(str(rsItems!ItemParent)), tvwChild, "A" & Trim(str(rsItems!ItemID)), rsItems!ItemName, 3
End Select
AccNo = AccNo + 1
rsItems.MoveNext
Loop
End If
tvItems.Nodes("A" & Trim(str(intAccID))).Selected = True
tvItems.Nodes("A" & Trim(str(intAccID))).Parent.Expanded = True
SetItemDetails intAccID
lblTitle.Caption = AccNo & " Item head(s)."

End Sub
Private Sub ClearFields()
txtItemName.Text = ""
txtItemName.Tag = ""
txtAliasName.Text = ""
txtItemCode.Text = ""
txtWidth.Text = "0.00"
txtGauge.Text = "0.00"
txtLength.Text = "0.00"
txtAliasName.Text = "0.00"
UnitCombo.ListIndex = 0
UnitCombo.Text = "MT"
WidthUnitCombo.ListIndex = 0
WidthUnitCombo.Text = "mm"
LengthUnitCombo.ListIndex = 0
LengthUnitCombo.Text = "mm"
GuageUnitCombo.ListIndex = 0
GuageUnitCombo.Text = "mm"
chkItemCategory.Value = 0
dxPEField1.EditValue = "ItemCode"
txtSearch.Text = ""
If ItemGroup.ListCount > 0 Then ItemGroup.ListIndex = 0
If StockCategory.ListCount > 0 Then StockCategory.ListIndex = 0
ItemGroup.ListIndex = 1
'CategoryCombo.Text = "SG"
txtRemarks.Text = "Nil"
blnSearchingFromBeginning = False
End Sub

Private Sub ItemGroup_Change()
ItemGroup_Click
End Sub

Private Sub ItemGroup_Click()
ItemCategoryFilling
End Sub

Private Sub optItem_Click()
If optItem.Value = True Then
Frame5.Visible = True
Frame5.Enabled = True
chkItemCategory.Visible = False
End If
End Sub

Private Sub optItemGroup_Click()
If optItemGroup.Value = True Then
Frame5.Visible = False
Frame5.Enabled = False
chkItemCategory.Visible = True
End If
End Sub

Private Sub tvItems_NodeClick(ByVal Node As MSComctlLib.Node)
If tvItems.SelectedItem.Key = "A0" Then
cmdModify.Enabled = False
cmdDelete.Enabled = False
ClearFields
Else
cmdModify.Enabled = True
cmdDelete.Enabled = True
If Not blnEditMode Then SetItemDetails (Val(Mid(tvItems.SelectedItem.Key, 2, Len(tvItems.SelectedItem.Key) - 1)))
End If
End Sub

Private Function SetItemDetails(intITemID As Integer)
Dim rsDetails As New ADODB.Recordset, iSql As String
iSql = "Select HISItem.Itemid,ItemCode,ItemName,ItemAlias," & _
"Itemtype, ItemParent, ItemRoot, Remarks,ItemCategory,isITemCategory,KeepingInventory,StockCategoryID," & _
"Gauge,Width,Length,WidthUnitID,LengthUnitId,GaugeUnitID,DefaultUnitID," & _
"(select distinct Description from hisStockCategory Where StockCategoryID = hisItem.StockCategoryID and FyearID = " & HadleyISFyearID & " ) as Description," & _
"(select distinct subCategory from hisStockCategory Where StockCategoryID = hisItem.StockCategoryID and FyearID = " & HadleyISFyearID & " ) as subCategory," & _
"(select UnitName from hisUnit Where unitID = hisItem.WidthUnitID)as widthUnit," & _
"(select UnitName from hisUnit Where unitID = hisItem.LengthUnitID)as LengthUnit," & _
"(select UnitName from hisUnit Where unitID = hisItem.GaugeUnitID)as GaugeUnit," & _
"(select UnitName from hisUnit Where unitID = hisItem.DefaultUnitID)as DefaultUnit," & _
" ParentName = " & _
" CASE WHEN ItemParent= 0 THEN 'N.A' " & _
" WHEN ItemParent > 0 THEN (Select ItemName from " & _
" HISItem A where A.ItemID = HISItem.ItemParent ) END " & _
" ,RootName = " & _
" CASE WHEN ItemRoot = 0 THEN 'ROOT' " & _
" WHEN ItemRoot > 0 THEN (Select ItemName from " & _
" HISItem A where A.ItemID = HISItem.ItemRoot ) END from " & _
" HISItem " & _
" Where HISItem.Companyid = " & HadleyISCompanyID & " and HISItem.ItemID = " & _
intITemID & _
" order by HISItem.ItemID "
If rsDetails.State = adStateOpen Then rsDetails.Close
rsDetails.Open iSql, HadleyISCnn, adOpenStatic, adLockReadOnly
If rsDetails.RecordCount > 0 Then
If rsDetails!isitemCategory Then
ItemGroup.Text = Trim(rsDetails!ParentName)
Else
ItemGroup.Text = Trim(rsDetails!RootName)
End If

If rsDetails!ItemType = 3 Then
optItem.Value = True
optItem_Click
ItemCategoryFilling
If Val(rsDetails!ItemCategory) = 0 Then
CategoryCombo.Text = Trim("N.A")
Else
CategoryCombo.Text = Trim(rsDetails!ParentName)
End If

Else
optItemGroup.Value = True
optItemGroup_Click

End If
If rsDetails!isitemCategory Then
chkItemCategory = 1
Else
chkItemCategory = 0
End If

txtItemName.Text = Trim(rsDetails!ItemName)
txtItemName.Tag = Val(intITemID)
txtItemCode.Text = Trim(rsDetails!ItemCode)
txtAliasName.Text = Trim(rsDetails!Itemalias)
If rsDetails!KeepingInventory Then
chkInventory.Value = 1
Else
chkInventory.Value = 0
End If
If Val(rsDetails!StockCategoryID) = 0 Then
StockCategory.Text = Trim("None")
Else
StockCategory.Text = Trim(rsDetails!Description) & "-" & Trim(rsDetails!SubCategory)
End If
txtGauge.Text = Format(Val(rsDetails!gauge), "0.00")
txtWidth.Text = Format(Val(rsDetails!width), "0.00")
txtLength.Text = Format(Val(rsDetails!Length), "0.00")
GuageUnitCombo.Text = Trim(rsDetails!GaugeUnit)
LengthUnitCombo.Text = Trim(rsDetails!lengthUnit)
WidthUnitCombo.Text = Trim(rsDetails!WidthUnit)
UnitCombo.Text = Trim(rsDetails!DefaultUnit)
txtRemarks.Text = Trim(rsDetails!Remarks)
End If
If rsDetails.State = adStateOpen Then rsDetails.Close
Set rsDetails = Nothing
End Function

Private Sub ItemGroupFilling()
'Filling Item Group
Dim X As Long
ItemGroup.Clear
Dim rsItem As New ADODB.Recordset
ItemGroup.AddItem "ROOT", X
ItemGroup.ItemData(X) = 0
If rsItem.State = adStateOpen Then rsItem.Close
rsItem.Open "Select ItemID, ItemName from HISItem where (ItemType =1 Or ItemType =2 )" & _
" and ((ItemId = " & Val(HadleyISWideCoilCategoryID) & ")OR ( ItemParent =" & Val(HadleyISWideCoilCategoryID) & ") OR ItemGroupId = " & Val(HadleyISWideCoilCategoryID) & ")" & _
"and ISItemCategory =0 and CompanyID = " & HadleyISCompanyID & " order by ITemName", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsItem.RecordCount > 0 Then
While Not rsItem.EOF
X = X + 1
ItemGroup.AddItem rsItem!ItemName, X
ItemGroup.ItemData(X) = rsItem!ItemID
rsItem.MoveNext
Wend
End If
Set rsItem = Nothing
ItemGroup.ListIndex = 0
End Sub
Private Sub ItemCategoryFilling()
'Filling Item Group
Dim X As Long
CategoryCombo.Clear
Dim rsItem As New ADODB.Recordset
CategoryCombo.AddItem "N.A", X
CategoryCombo.ItemData(X) = 0
If rsItem.State = adStateOpen Then rsItem.Close
rsItem.Open "Select ItemID, ItemName from HISItem where ItemParent = " & Val(ItemGroup.ItemData(ItemGroup.ListIndex)) & _
" and ItemType =2 and CompanyID = " & HadleyISCompanyID & " order by ITemName", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsItem.RecordCount > 0 Then
While Not rsItem.EOF
X = X + 1
CategoryCombo.AddItem rsItem!ItemName, X
CategoryCombo.ItemData(X) = rsItem!ItemID
rsItem.MoveNext
Wend
End If
Set rsItem = Nothing
CategoryCombo.ListIndex = 0
End Sub

Private Sub txtGauge_GotFocus()
SendKeys "{Home}+{End}"
End Sub

Private Sub txtItemName_Change()
txtAliasName.Text = txtItemName.Text
End Sub

Private Sub txtItemName_GotFocus()
txtItemName.BackColor = HadleyISFocusColor
SendKeys "{Home}+{End}"
End Sub

Private Sub txtItemName_LostFocus()
txtItemName.BackColor = HadleyISNormalColor
End Sub

Private Sub txtAliasName_GotFocus()
txtAliasName.BackColor = HadleyISFocusColor
SendKeys "{Home}+{End}"
End Sub

Private Sub txtAliasName_LostFocus()
txtAliasName.BackColor = HadleyISNormalColor
End Sub

Private Sub txtRemarks_GotFocus()
txtRemarks.BackColor = HadleyISFocusColor
SendKeys "{Home}+{End}"
End Sub

Private Sub txtRemarks_LostFocus()
txtRemarks.BackColor = HadleyISNormalColor
End Sub

Private Sub txtSearch_Change()
blnSearchingFromBeginning = True
End Sub

Private Sub txtSearch_GotFocus()
txtSearch.BackColor = HadleyISFocusColor
SendKeys "{Home}+{End}"
End Sub

Private Sub txtSearch_LostFocus()
txtSearch.BackColor = HadleyISNormalColor
End Sub
Private Sub SetUnitcategory()
UnitCombo.Clear
Dim rsUnit As New ADODB.Recordset
UnitCombo.AddItem "None"
UnitCombo.ItemData(UnitCombo.ListCount - 1) = 0
If rsUnit.State = adStateOpen Then rsUnit.Close
rsUnit.Open "Select UnitName,UnitID from HIsUnit Where UnitType =2 Order By UnitName ", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsUnit.RecordCount > 0 Then
Do While Not rsUnit.EOF
UnitCombo.AddItem rsUnit!UnitName
UnitCombo.ItemData(UnitCombo.ListCount - 1) = rsUnit!UnitID
rsUnit.MoveNext
Loop
UnitCombo.ListIndex = 0
Else
End If
Set rsUnit = Nothing

End Sub
Private Sub SetLengthUnitcategory()
GuageUnitCombo.Clear
WidthUnitCombo.Clear
LengthUnitCombo.Clear
Dim rsUnit As New ADODB.Recordset
GuageUnitCombo.AddItem "None"
GuageUnitCombo.ItemData(GuageUnitCombo.ListCount - 1) = 0
WidthUnitCombo.AddItem "None"
WidthUnitCombo.ItemData(WidthUnitCombo.ListCount - 1) = 0
LengthUnitCombo.AddItem "None"
LengthUnitCombo.ItemData(LengthUnitCombo.ListCount - 1) = 0

If rsUnit.State = adStateOpen Then rsUnit.Close
rsUnit.Open "Select UnitName,UnitID from HIsUnit Where UnitType =2 and UnitParent =4 Order By UnitName ", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsUnit.RecordCount > 0 Then
Do While Not rsUnit.EOF
GuageUnitCombo.AddItem rsUnit!UnitName
GuageUnitCombo.ItemData(GuageUnitCombo.ListCount - 1) = rsUnit!UnitID
WidthUnitCombo.AddItem rsUnit!UnitName
WidthUnitCombo.ItemData(WidthUnitCombo.ListCount - 1) = rsUnit!UnitID
LengthUnitCombo.AddItem rsUnit!UnitName
LengthUnitCombo.ItemData(LengthUnitCombo.ListCount - 1) = rsUnit!UnitID
rsUnit.MoveNext
Loop
GuageUnitCombo.ListIndex = 0
WidthUnitCombo.ListIndex = 0
LengthUnitCombo.ListIndex = 0
Else
End If
Set rsUnit = Nothing

End Sub


Private Sub SelectItemsNew()
tvItems.Nodes.Add , , "A0", "Item Groups & Categories", 1
Dim rsGroups As New ADODB.Recordset, rsItems As New ADODB.Recordset
If rsGroups.State = adStateOpen Then rsGroups.Close
rsGroups.Open "Select ItemID, ItemName, ItemParent, ItemType" & _
" From HISItem Where Companyid=" & HadleyISCompanyID & " And ItemType <> 3 " & _
" Order by ItemType", HadleyISCnn, adOpenStatic, adLockReadOnly
If rsGroups.RecordCount > 0 Then
Dim intAccID As Integer, AccNo As Integer
rsGroups.MoveFirst
Do While Not rsGroups.EOF
intAccID = rsGroups!ItemID
Select Case rsGroups!ItemType
Case 1
tvItems.Nodes.Add "A0", tvwChild, "A" & Trim(str(rsGroups!ItemID)), rsGroups!ItemName, 2
Case 2
tvItems.Nodes.Add "A" & Trim(str(rsGroups!ItemParent)), tvwChild, "A" & Trim(str(rsGroups!ItemID)), rsGroups!ItemName, 2
End Select
If rsItems.State = adStateOpen Then rsItems.Close
rsItems.Open "Select ItemID, ItemName, ItemParent from HISItem " & _
" Where CompanyID = " & HadleyISCompanyID & " And ItemParent = " & rsGroups!ItemID & _
" And ItemType = 3 Order By ItemName", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsItems.RecordCount > 0 Then
Do While Not rsItems.EOF
tvItems.Nodes.Add "A" & Trim(str(rsGroups!ItemID)), tvwChild, "A" & Trim(str(rsItems!ItemID)), rsItems!ItemName, 3
AccNo = AccNo + 1
rsItems.MoveNext
Loop
End If
rsGroups.MoveNext
Loop
tvItems.Nodes("A" & Trim(str(intAccID))).Selected = True
tvItems.Nodes("A" & Trim(str(intAccID))).Parent.Expanded = True
SetItemDetails intAccID
lblTitle.Caption = AccNo & " Item head(s)."
End If
End Sub

Private Sub txtWidth_GotFocus()
SendKeys "{Home}+{End}"
End Sub
Private Sub SetStockCategory()
StockCategory.Clear
Dim rsUnit As New ADODB.Recordset
StockCategory.AddItem "None"
StockCategory.ItemData(StockCategory.ListCount - 1) = 0
If rsUnit.State = adStateOpen Then rsUnit.Close
rsUnit.Open "Select distinct Description,subCategory,StockCategoryID from HIsStockCategory Where ItemGroupID =" & Val(HadleyISWideCoilCategoryID) & " Order By Description ", HadleyISCnnGQ, adOpenStatic, adLockReadOnly, adCmdText
If rsUnit.RecordCount > 0 Then
Do While Not rsUnit.EOF
StockCategory.AddItem rsUnit!Description + "-" + rsUnit!SubCategory
StockCategory.ItemData(StockCategory.ListCount - 1) = rsUnit!StockCategoryID
rsUnit.MoveNext
Loop
StockCategory.ListIndex = 0

Else
End If
Set rsUnit = Nothing

End Sub

-------------This is the code that works from last 3-4 years ---------but now it gives error

Regards,
Lalit

 

[Andrzejek]

Lalit2015,
In my opinion, nobody in their right mind will go thru 2 acres of code trying to figure out where it may error, since you should know which line of the code (or a piece of logic) creates the error. Test it, create the error, your program will stop on that line of code and highlights it in yellow.

And please use TGML tags to show your code.


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[strongm]

Quite. Some sort of clue would be good ...

 

[Andrzejek]

Just a guess here, a shot in the dark.

Place a command button and a combo box on the form. Run this code below:

Option Explicit

Private Sub Command1_Click()

With Combo1
    .AddItem "One"
    .AddItem "Two"
    .AddItem "Three"
    [blue]
    .Text = "Something else"[/blue]
End With

End Sub

The code runs fine.
Now, change the Combobox1’s Style property to 2 – DropDownList and run the same code again.

You will stop/crash on a BLUE line of code with your error.

Is it something similar to your problem in your code?

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[Lalit2015]

Hi,

Many Times I did test but the thing is that This code work in test server but in the Live server It not works.

Further more this code write behind on the form which is load when we click on that menu.

Now How will I judge even its give error at the time of loading the form.

Regards,
LALT

 

[Andrzejek]

I hope you trap errors in your code, don't you?
You can place line numbers in your code and detect which line (number) of code creates the error.

For an easy way to add/remove line numbers use [link MZTools.com]MZTools[/url] It is free.

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[tedsmith]

Is it possible you have sharing set to read only? (Or someone else has changed it)
If you have recently changed a machine to win 7, the sharing of folders on a network is more restricted unless you change permission.

 

[Unscruffed]

It looks to me (from the screenshot) that the only controls which can have Read Only Text properties are the ComboBoxes.

With ComboBoxes, the Text property is read only if ComboBox.Style = 2 (Dropdown List). In this case, you can only set the Text property if the text you are trying to set already exists in the ComboBox's list (previously added using the AddItem method).

If you need to set the Text property using text which has not been previously added to a ComboBox, then you need to set ComboBox.Style = 0 (Dropdown Combo).

Note that setting ComboBox.Style = 0 (Dropdown Combo) means that users can type anything they want into the ComboBox. If you don't want users to be able to do this, then you need to add the text in code first, then select it. Best way to do that is:

ComboBox.AddItem "New text entry"
ComboBox.ListIndex = ComboBox.NewIndex

If you are using ComboBox.Style = 2 (Dropdown List), you should try to avoid selecting text by setting the Text property. If you must have that functionality, then it's best to check that the text exists first by making a simple API call.

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[tedsmith]

Did you make a setup program and properly install it on any computers that may have been updated from XP to Win7?

I have had similar problems with a program compiled in Win 7 32 bit machine but run on a computer with XP64 bit machine. The error message can be nothing to do with the actual error but when the code is recompiled on the machine it is used on, everything is OK.
I suspect it has something to do with compatibility of 32 bit or 64 bit DLLS but have not been able to track it down.