M
Michael Anderson
I've been customising a Contact Form using an Exchage Server with the
following code. The "Admin" form
1) Prints out records from month that user specifies in Contact Folder. I've
published a form called "RITO Contacts" there.
2) Prints out all records in Contact Folder. The "Counter" form increments
a counter published on that form.
When I run it I get "unknown exception" error referring to
<--mxzParentCompany = objItem.UserProperties("mxzParentCompany")--> in Sub
mxzcboExportAllRecords_Click(). The Function "OpenMAPIFolder" is from Randy
Byrne's "Building Apps w' Outlook 02" pp472-473. Is there code that would be
more appropriate for the Exchange Environment? Please provide Help!
'******************
' Purpose: mxzcboRenewal_Click() prints out the current renewal
' record field values in a tab separated text file. This is a working
' model towards printing out all current records.
'******************
'Stop
Sub mxzcboRenewal_Click()
Dim fso
Dim MyFile
Dim olNS
Dim MyFolder
Dim MyCounterFolder
Dim myItems
Dim objInspector
Dim objItem
Dim objItemCounter
Dim objtxtItemCounterEntryID
Dim objItemCounterStoreID
Dim mxztxtTransactionDate
Dim mxztxtUserRenewalDateInput
Dim mxztxtUserRenewalDateInputDetails
Dim mxzMembershipRenewalMonthTemp
Dim mxztxtMemNum
Dim mxznumInvNumTemp
Dim mxznumInvNumPrint
Dim mxzcurTaxAmount
Dim mxztxtFullName
Const NoneDate = 949998
Const mxztxtTransactionType = "SI"
Const mxzintGLCode = 2099
Const mxztxtTransactionDetails = "Annual Membership"
Const mxzcurNetAmount = 100.00
Const mxztxtTaxCode = "T2"
Const mxztxtExtraReference = "Sample"
Set objInspector = Item.GetInspector
Set olNS = Item.Application.GetNamespace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = OpenMAPIFolder("Public Folders\All Public Folders\RITO
Contacts")
Set MyCounterFolder = OpenMAPIFolder("Public Folders\All Public
Folders\RITO Admin\Counter")
Set MyFile = fso.CreateTextFile("c:\Ren33.txt", True)
'Get user date variable
mxztxtUserRenewalDateInput = InputBox("Please Insert Renewal Date
Month", _
"Please Insert Renewal Date Month", "January")
Select Case mxztxtUserRenewalDateInput
Case "January"
Case "February"
Case "March"
Case "April"
Case "May"
Case "June"
Case "July"
Case "August"
Case "September"
Case "October"
Case "November"
Case "December"
'Dummy variable to get values beyond Case Statement
mxztxtUserRenewalDateInputDetails = mxztxtUserRenewalDateInput
Case Else
MsgBox "Enter Valid Date"
End Select
For Each objItem In MyCounterFolder.Items
If objItem.UserProperties("Full Name").Value = "B1ank R3c0rd" Then
objtxtItemCounterEntryID = objItem.EntryID
objItemCounterStoreID = MyFolder.StoreID
End If
Next
Set objItemCounter = olNS.GetItemFromID(objtxtItemCounterEntryID, _
objItemCounterStoreID)
For Each objItem In MyFolder.Items
'Enter records date variables into another Date
mxzMembershipRenewalMonthTemp =
objItem.UserProperties("mxztxtMemRenMonth").Value
'Compare user date variable with records date variables
If mxztxtUserRenewalDateInput = mxzMembershipRenewalMonthTemp Then
mxztxtTransactionDate = DateValue(Now)
mxztxtMemNum = objItem.UserProperties("mxztxtMemNum").Value
mxznumInvNumTemp = objItemCounter.UserProperties("mxznumInvNo").Value
mxznumInvNumTemp = mxznumInvNumTemp + 1
mxznumInvNumPrint = mxznumInvNumTemp
objItemCounter.UserProperties("mxznumInvNo").Value =
mxznumInvNumTemp
With objItemCounter
.Save
End With
mxznumInvNumTemp = 0
mxzcurTaxAmount = mxzcurNetAmount / 8
mxztxtFullName = objItem.UserProperties("Full Name").Value
MyFile.WriteLine (mxztxtTransactionType & " " & mxztxtMemNum &
" " & mxzintGLCode & " " _
& mxztxtTransactionDate & " " & mxznumInvNumPrint & " " _
& mxztxtTransactionDetails & " " & mxzcurNetAmount & " " &
mxztxtTaxCode & " " _
& mxzcurTaxAmount & " " & mxztxtExtraReference & " " &
mxztxtFullName)
End If
Next
MyFile.Close
'Release General variables
Set fso = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set MyCounterFolder = Nothing
Set MyFile = Nothing
Set objItem = Nothing
Set objItemCounter = Nothing
Set objInspector = Nothing
End Sub
'******************
' Purpose: mxzcboExportAllRecords_Click() prints out the current
' record field values in a tab separated text file. This is a working
' model towards printing out all current records.
'******************
Sub mxzcboExportAllRecords_Click()
Dim fso, MyFile
Dim olNS
Dim MyFolder
Dim FolderPath
Dim objItem
Dim objInspector
'Declare General form page variables
Dim mxzParentCompany
Set objInspector = Item.GetInspector
Set olNS = Item.Application.GetNameSpace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = OpenMAPIFolder("Public Folders\All Public Folders\RITO
Contacts")
Set MyFile = fso.CreateTextFile("c:\testfileAdmin103.txt", True)
For Each objItem In MyFolder.Items
'Assign values to General form page variables
mxzParentCompany = objItem.UserProperties("mxzParentCompany")
MyFile.Write("Record:" & " " & mxzParentCompany)
Next
MyFile.Close
'Release General variables
Set fso = Nothing
Set objInspector = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set objItem = Nothing
'Release General form page variables
Set mxzParentCompany = Nothing
End Sub
Function OpenMAPIFolder(strPath)
Dim objFldr
Dim strDir
Dim strName
Dim i
On Error Resume Next
If Left(strPath, Len("\")) = "\" Then
strPath = Mid(strPath, Len("\") + 1)
Else
Set objFldr = Application.ActiveExplorer.CurrentFolder
End If
While strPath <> ""
i = InStr(strPath, "\")
If i Then
strDir = Left(strPath, i - 1)
strPath = Mid(strPath, i + Len("\"))
Else
strDir = strPath
strPath = ""
End If
If objFldr Is Nothing Then
Set objFldr = Application.GetNameSpace("MAPI").Folders(strDir)
On Error Goto 0
Else
Set objFldr = objFldr.Folders(strDir)
End If
Wend
Set OpenMAPIFolder = objFldr
End Function
following code. The "Admin" form
1) Prints out records from month that user specifies in Contact Folder. I've
published a form called "RITO Contacts" there.
2) Prints out all records in Contact Folder. The "Counter" form increments
a counter published on that form.
When I run it I get "unknown exception" error referring to
<--mxzParentCompany = objItem.UserProperties("mxzParentCompany")--> in Sub
mxzcboExportAllRecords_Click(). The Function "OpenMAPIFolder" is from Randy
Byrne's "Building Apps w' Outlook 02" pp472-473. Is there code that would be
more appropriate for the Exchange Environment? Please provide Help!
'******************
' Purpose: mxzcboRenewal_Click() prints out the current renewal
' record field values in a tab separated text file. This is a working
' model towards printing out all current records.
'******************
'Stop
Sub mxzcboRenewal_Click()
Dim fso
Dim MyFile
Dim olNS
Dim MyFolder
Dim MyCounterFolder
Dim myItems
Dim objInspector
Dim objItem
Dim objItemCounter
Dim objtxtItemCounterEntryID
Dim objItemCounterStoreID
Dim mxztxtTransactionDate
Dim mxztxtUserRenewalDateInput
Dim mxztxtUserRenewalDateInputDetails
Dim mxzMembershipRenewalMonthTemp
Dim mxztxtMemNum
Dim mxznumInvNumTemp
Dim mxznumInvNumPrint
Dim mxzcurTaxAmount
Dim mxztxtFullName
Const NoneDate = 949998
Const mxztxtTransactionType = "SI"
Const mxzintGLCode = 2099
Const mxztxtTransactionDetails = "Annual Membership"
Const mxzcurNetAmount = 100.00
Const mxztxtTaxCode = "T2"
Const mxztxtExtraReference = "Sample"
Set objInspector = Item.GetInspector
Set olNS = Item.Application.GetNamespace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = OpenMAPIFolder("Public Folders\All Public Folders\RITO
Contacts")
Set MyCounterFolder = OpenMAPIFolder("Public Folders\All Public
Folders\RITO Admin\Counter")
Set MyFile = fso.CreateTextFile("c:\Ren33.txt", True)
'Get user date variable
mxztxtUserRenewalDateInput = InputBox("Please Insert Renewal Date
Month", _
"Please Insert Renewal Date Month", "January")
Select Case mxztxtUserRenewalDateInput
Case "January"
Case "February"
Case "March"
Case "April"
Case "May"
Case "June"
Case "July"
Case "August"
Case "September"
Case "October"
Case "November"
Case "December"
'Dummy variable to get values beyond Case Statement
mxztxtUserRenewalDateInputDetails = mxztxtUserRenewalDateInput
Case Else
MsgBox "Enter Valid Date"
End Select
For Each objItem In MyCounterFolder.Items
If objItem.UserProperties("Full Name").Value = "B1ank R3c0rd" Then
objtxtItemCounterEntryID = objItem.EntryID
objItemCounterStoreID = MyFolder.StoreID
End If
Next
Set objItemCounter = olNS.GetItemFromID(objtxtItemCounterEntryID, _
objItemCounterStoreID)
For Each objItem In MyFolder.Items
'Enter records date variables into another Date
mxzMembershipRenewalMonthTemp =
objItem.UserProperties("mxztxtMemRenMonth").Value
'Compare user date variable with records date variables
If mxztxtUserRenewalDateInput = mxzMembershipRenewalMonthTemp Then
mxztxtTransactionDate = DateValue(Now)
mxztxtMemNum = objItem.UserProperties("mxztxtMemNum").Value
mxznumInvNumTemp = objItemCounter.UserProperties("mxznumInvNo").Value
mxznumInvNumTemp = mxznumInvNumTemp + 1
mxznumInvNumPrint = mxznumInvNumTemp
objItemCounter.UserProperties("mxznumInvNo").Value =
mxznumInvNumTemp
With objItemCounter
.Save
End With
mxznumInvNumTemp = 0
mxzcurTaxAmount = mxzcurNetAmount / 8
mxztxtFullName = objItem.UserProperties("Full Name").Value
MyFile.WriteLine (mxztxtTransactionType & " " & mxztxtMemNum &
" " & mxzintGLCode & " " _
& mxztxtTransactionDate & " " & mxznumInvNumPrint & " " _
& mxztxtTransactionDetails & " " & mxzcurNetAmount & " " &
mxztxtTaxCode & " " _
& mxzcurTaxAmount & " " & mxztxtExtraReference & " " &
mxztxtFullName)
End If
Next
MyFile.Close
'Release General variables
Set fso = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set MyCounterFolder = Nothing
Set MyFile = Nothing
Set objItem = Nothing
Set objItemCounter = Nothing
Set objInspector = Nothing
End Sub
'******************
' Purpose: mxzcboExportAllRecords_Click() prints out the current
' record field values in a tab separated text file. This is a working
' model towards printing out all current records.
'******************
Sub mxzcboExportAllRecords_Click()
Dim fso, MyFile
Dim olNS
Dim MyFolder
Dim FolderPath
Dim objItem
Dim objInspector
'Declare General form page variables
Dim mxzParentCompany
Set objInspector = Item.GetInspector
Set olNS = Item.Application.GetNameSpace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = OpenMAPIFolder("Public Folders\All Public Folders\RITO
Contacts")
Set MyFile = fso.CreateTextFile("c:\testfileAdmin103.txt", True)
For Each objItem In MyFolder.Items
'Assign values to General form page variables
mxzParentCompany = objItem.UserProperties("mxzParentCompany")
MyFile.Write("Record:" & " " & mxzParentCompany)
Next
MyFile.Close
'Release General variables
Set fso = Nothing
Set objInspector = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set objItem = Nothing
'Release General form page variables
Set mxzParentCompany = Nothing
End Sub
Function OpenMAPIFolder(strPath)
Dim objFldr
Dim strDir
Dim strName
Dim i
On Error Resume Next
If Left(strPath, Len("\")) = "\" Then
strPath = Mid(strPath, Len("\") + 1)
Else
Set objFldr = Application.ActiveExplorer.CurrentFolder
End If
While strPath <> ""
i = InStr(strPath, "\")
If i Then
strDir = Left(strPath, i - 1)
strPath = Mid(strPath, i + Len("\"))
Else
strDir = strPath
strPath = ""
End If
If objFldr Is Nothing Then
Set objFldr = Application.GetNameSpace("MAPI").Folders(strDir)
On Error Goto 0
Else
Set objFldr = objFldr.Folders(strDir)
End If
Wend
Set OpenMAPIFolder = objFldr
End Function