[mso] Re: Custom Form VB Bug Help Needed
- From: "Dian Chapman" <dian@xxxxxxxxxxxxx>
- To: <mso@xxxxxxxxxxxxx>
- Date: Fri, 17 Oct 2003 23:44:45 -0500
I take it, that since this is from Sue, that you mean a custom Outlook form?
If so, you should clarify that fact as you can also have Word forms.
Sorry, I don't know the OL objModel well.
Dian D. Chapman
Technical Consultant,
Microsoft MVP & Instructor
Free Tutorials: www.mousetrax.com/techtrax
Free Word Tips & Tricks eBook: www.mousetrax.com/books.html
Learn VBA the easy way, thru video! www.mousetrax.com/techcourses.html
-----Original Message-----
From: mso-bounce@xxxxxxxxxxxxx [mailto:mso-bounce@xxxxxxxxxxxxx] On Behalf
Of Sandy Crowley
Sent: Friday, October 17, 2003 10:30 AM
To: mso@xxxxxxxxxxxxx
Subject: [mso] Custom Form VB Bug Help Needed
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
*************************************************************
*************************************************************
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:
