OutLook Customization - Issue with Custom forms

We are facing some issues for the Outlook 2007 Scripting for the following features implemented in one of our customer.

1. Ref Number Generation
2. Automatically fill in the "From", "BCC" fields of a message based on the selected profiles( user may be having more than one shared mail box plus one personal mail box).Personal mail box is the default mail profile.
3. Differentiate the read mail and unread mail by specifying that in a field for shared mail box.

Issues Faced for the above feature

1. Mails are getting delivered but stay in the outbox itself.
2. Some time forms are not getting opened, which need a clear
cache (Tools->Options->Other-> Advanced Options ->Custom Forms->Manage Forms->Clear cache).
3. Some time forms are getting opened with small body text box
which also needs a clear cache (Tools->Options->Other-> Advanced Options ->Custom Forms->Manage Forms->Clear cache)
4. Customized message Forms are not getting opened in a single
attempt, instead of that we have focus on other mails then we have to select
the appropriate mail to open.

We are using Exchange server 2007 with office 2007 . we are using Vista Business Edition OS.

My script is

Public WithEvents myOlItems As Outlook.Items
Public WithEvents objcur As Outlook.MailItem
Dim objFolder As Outlook.Folder

Dim path, field
Dim FromID As String
Dim boolval As Boolean

Private Sub Application_ItemLoad(ByVal Item As Object)
Dim prntfolder As Outlook.Folder
Dim Inspector1 As Inspector
On Error Resume Next
Item.MessageClass = "IPM.Note.Message"

If (Item.MessageClass = "IPM.Note.Message") Then
Set objNS = Application.GetNamespace("MAPI").Accounts
Set DBFld = OpenDatabase(Name:="c:\integra\olref.mdb")

If (Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder.Parent <> "Mapi") Then
Set prntfolder = Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder.Parent
Else
Set prntfolder = Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder
End If
Set RSFld = DBFld.OpenRecordset("Select emailid from GrpMail where PrntFlder='" & prntfolder & "'")

Set objcur = Item

If (RSFld.RecordCount > 0) Then
FromID = RSFld.emailid
End If
End If

End Sub
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Call AUTOREF(Item)
Item.Save
'End If
End Sub
Sub AUTOREF(objmail As MailItem)
On Error GoTo Errorhandler:

Set DB = OpenDatabase(Name:="c:\integra\olref.mdb")
Set RS = DB.OpenRecordset("Select * from mail order by RefNo")
Set RSSender = DB.OpenRecordset(Name:="Sender")
SendID = RSSender.SendID
If RS.RecordCount = 0 Then
NO = 1
Else
RS.MoveLast
NO = RS.RefNo + 1
End If
msg = objmail.Subject
r = Str(NO)
strRefNo = objmail.Subject

If (InStr(strRefNo, "[") > 0 And InStr(strRefNo, "]") > 0) Then
strRefNo = Mid(strRefNo, InStr(strRefNo, "[") + 1, 9) ' If change in structure note here
If (InStr(strRefNo, ":") <= 0 And IsNumeric(Right(strRefNo, 5)) = False) Then
strRefNo = ""
End If
Else
strRefNo = ""
End If


If (objmail.ItemProperties.Item("From").Value <> "") Then
objmail.BCC = objmail.ItemProperties.Item("From").Value
End If

If (strRefNo <> "") Then
Set RSRefNo = DB.OpenRecordset("Select count(*) as Count from Records where RefNo='" & Left(strRefNo, 9) & "'")
Set RSUpdRefNo = DB.OpenRecordset(Name:="Records")
RSUpdRefNo.AddNew
RSUpdRefNo.RefNo = Left(strRefNo, 9)
RSUpdRefNo.Update
strRefNo = Left(strRefNo, 9) & ":" & SendID & "-" & SubRefNo(RSRefNo.Count + 1)
RSRefNo.Close
RSUpdRefNo.Close
Else
strRefNo = SendID & ":" & RefNo(r)
objmail.Subject = "[" & strRefNo & "]" & objmail.Subject
End If
NewProperty = objmail.UserProperties.Add("RefNo", olText)
objmail.UserProperties.Find("RefNo").Value = strRefNo
objmail.Save

RS.AddNew
RS.RefNo = NO
RS.Date = Date
RS.msg = msg
RS.Update
RS.Close
RSSender.Close
DB.Close
End
Errorhandler:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
End
End Sub
Function FindinDB(strRefNo As String) As Integer
FindinDB RS.Count
End Function
Function RefNo(ByVal r As String)
If (Len(Trim(r)) = 1) Then
RefNo = "0000" & Trim(r)
ElseIf (Len(Trim(r)) = 2) Then
RefNo = "000" & Trim(r)
ElseIf (Len(Trim(r)) = 3) Then
RefNo = "00" & Trim(r)
ElseIf (Len(Trim(r)) = 4) Then
RefNo = "0" & Trim(r)
Else
RefNo = Trim(r)
End If
End Function
Function SubRefNo(ByVal r As String)
If (Len(Trim(r)) = 1) Then
SubRefNo = "0" & Trim(r)
Else
SubRefNo = Trim(r)
End If
End Function

Private Sub Application_NewMail()
boolval = True

End Sub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
boolval = True
'MsgBox EntryIDCollection
On Error Resume Next
Dim NewMail As Outlook.MailItem

'ApplicationClass o = new ApplicationClass();
Set objNS = Application.GetNamespace("MAPI")
If (Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder.Parent <> "Mapi") Then
Set objFolder = Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder.Parent
Else
Set objFolder = Application.GetNamespace("MAPI").Folders.Application.ActiveExplorer.CurrentFolder
End If
'Set objFolder = objNS.Folders.Item(OlDefaultFolders.olFolderInbox)
'MAPIFolder mFolder = o.Session.GetDefaultFolder(OlDefaultFolders.olFolderInbox);
Set NewMail = objNS.GetItemFromID(EntryIDCollection, objFolder.StoreID)
NewMail.MessageClass = "IPM.Note.Read"
NewMail.Save
End Sub

Private Sub Application_OptionsPagesAdd(ByVal Pages As PropertyPages)

End Sub




Private Sub objcur_Open(Cancel As Boolean)
On Error Resume Next
if objcur.SenderName<>"" then
objcur.ItemProperties.Item("From").Value = FromID
objcur.ItemProperties.Item("BCC").Value = FromID
objcur.save
else
objcur.ItemProperties.Item("From").Value = objcur.SenderName
objcur.Save
end
End Sub




Private Sub objcur_Read()
On Error Resume Next
'MsgBox objcur.MessageClass
NewProperty = objcur.UserProperties.Add("mmests", olText)
objcur.UserProperties.Find("mmests").Value = "Read"

If (objcur.MessageClass <> "IPM.Note.Message" And boolval = False) Then
objcur.MessageClass = "IPM.Note.Message"
objcur.Save
End If

boolval = False
End Sub

Thanks and Regards,
Sankararam
Singapore

I wont get much deep into this coz its so biiiiig :devil: and I didn't understand much.
But I'll provide you with this Outlook 2007 custom forms - a black hole to avoid.
I hope that will help you in some or other way :rolleyes: