[mso] Custom Form VB Bug Help Needed
- From: "Sandy Crowley" <SCrowley@xxxxxxxxxxxxxxxx>
- To: <mso@xxxxxxxxxxxxx>
- Date: Fri, 17 Oct 2003 11:30:21 -0400
I have created a custom contact form. I have the following script in VB:
The problem is when I "run" the form, fill in Name, Company, Address,
Two Categories, and try to save it, I get "The Operation Failed". I'm
asking you VB gurus if there is a bug in my code. If not, can I post the
form and have one of you look at it? Thanks.
' ****************************************************************
' Required Category Contact Form
' By Sue Mosher, Slipstick Systems, http://www.slipstick.com
' Version 1, 11 May 1999
' Free and unrestricted use allowed to anyone
' No support provided, but feel free to send comments and
' enhancement suggestions to sue@xxxxxxxxxxxxxx
' ****************************************************************
' ******************* GLOBAL VARIABLES ***************************
Dim gstrRequiredCats
' ******************* FORM EVENTS ********************************
Function Item_Open()
' *** BEGIN USER OPTION ***
' Change the string in the next line to the required categories
' you want to see on the Categories tab, separated by semicolons.
' These should be the same as the Possible Values set on the Value
' tab of the list box' Properties
gstrRequiredCats = "00 Corporate; 1A Interior Architecture; 1B Office;
1D Financial Retail; 2A Financial Call Centers; 2A Civic; 2B Schools; 2C
College/University; 3A Corporate Roll-out; 3B Build to Suit; 3C Shopping
Centers; 3D Store Design; 3E Supermarkets; 4A Land Development Services;
4B Skyscraper; 4C Engineering; 4D FM Strategies; 5P Personal; A VIP; B
Customer; C Prospect; D Lead Source; EVendors; F Competitor; M Mail
List; R Report; X Project defined at used level; P Personal"
' *** END USER OPTION ***
' set required categories in label
Set objPage = Item.GetInspector.ModifiedFormPages("General")
Set objControl = objPage.Controls("lstCategories")
strLabel = "Please select two categories:" & vbCrLf & vbCrLf & "1.
(00-5P) Industry Group" & vbCrLf & vbCrLf & "2. (A-P) Client Type" &
vbCrLf & vbCrLf & "You can assign addiditional categories" & vbCrLf &
vbCrLf & "Contact will NOT SAVE if categories are not selected"
'arrRCats = Split(gstrRequiredCats, ";")
'For I = 0 to UBound(arrRCats)
'strLabel = strLabel & vbCrLf & Space(10) & Trim(arrRCats(I))
'Next
objPage.Controls("Label13").Caption = strLabel
' set category string to upper case for later testing
gstrRequiredCats = UCase(gstrRequiredCats)
End Function
Function Item_Write()
If HasRequiredCategory() = False Then
Item_Write = False
Item.GetInspector.SetCurrentFormPage "General"
Set objPage = Item.GetInspector.ModifiedFormPages("General")
Set objControl = objPage.Controls("lstCategories")
objControl.SetFocus
End If
End Function
' ******************* CUSTOM PROCEDURES *************************
' ***************************************************************
' Name: HasRequiredCategory
' Arguments: None
' Returns: True if item category matches a required category
' True if no required categories
' False if categories required, but no match
' ***************************************************************
Function HasRequiredCategory()
Dim intMatchCount
Dim intReqCats
'******USER OPTION*****
'number of category matches required
intReqCats = 2
Set objPage = Item.GetInspector.ModifiedFormPages("General")
Set objControl = objPage.Controls("lstCategories")
If gstrRequiredCats <> "" Then
arrCats = Split(UCase(Item.Categories),",")
arrRequiredCats = Split(gstrRequiredCats,";")
For I = 0 To UBound(arrCats, 1)
For J = 0 To UBound(arrRequiredCats, 1)
If Trim(arrCats(I)) = Trim(arrRequiredCats(J)) Then
intMatchCount = intMatchCount + 1
If intMatchCount >= intReqCats Then
Exit For
End If
End If
Next
If intMatchCount >= intReqCats Then
Exit For
End If
Next
End If
HasRequiredCategory = (intMatchCount >= intReqCats)
End Function
'Sub Item_Open
' Change the following line to your new Message Class
'NewMC = "IPM. Contact.MyNewForm"
'Set CurFolder = Application.ActiveExplorer.CurrentFolder
'Set AllItems = CurFolder.Items
'NumItems = CurFolder.Items.Count
' Loop through all of the items in the folder
'For I = 1 to NumItems
'Set CurItem = AllItems.Item(I)
'Test to see if the Message Class needs to be changed
'If CurItem.MessageClass <> NewMC Then
' Change the Message Class
'CurItem.MessageClass = NewMC
' Save the changed item
'CurItem.Save
'End If
'Next
'MsgBox "Done."
'End Sub
Sandy Crowley, SDA, CDT
Director of Administration | Senior Associate
Little Diversified Architectural Consulting
5815 Westpark Drive | Charlotte, NC 28217
D:704.561.5135 | M:704.408.0458 | F:704.561.8734
www.littleonline.com <http://www.littleonline.com/>
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, send an email to
mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the quotes) in
the subject line.
Or, visit the group's homepage and use the dropdown menu. This will also allow
you to change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to use the files section for sharing files with the group, send a
request to mso-moderators@xxxxxxxxxxxxx and you will be sent an invitation with
instructions. Once you are a member of the files group, you can go here to
upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************
Other related posts:
