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
Reply With Quote
and I didn't understand much. 
Bookmarks