📄 ch10.htm
字号:
<p>You'll notice that this routine allows you to place the messages in a list control for
sorting and display. You may also have noticed that the field placed in the controls is
the <tt><font FACE="Courier">ConversationIndex</font></tt> property. Sorting the messages
on the <tt><font FACE="Courier">ConversationIndex</font></tt> property will automatically
give you the threaded list you need. You can then take the sorted list from the list
control and use that to generate an onscreen display of the subject or other properties of
the message-all in threaded order! </p>
<p>You'll need three different routines to access messages from the user-defined array.
First, you need a routine that allows you to pass in a pointer to the sorted list and that
returns the <tt><font FACE="Courier">ConversationIndex</font></tt> of a message. Listing
10.7 shows how this is done. </p>
<hr>
<blockquote>
<b><p>Listing 10.7. Adding the <tt><font FACE="Courier">MsgIndex</font></tt> function.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Function MsgIndex(ctrl As Control, iPtr As Integer) As
String<br>
'<br>
' accept pointer to sorted list control <br>
' and the sorted list control<br>
' return msg convIndex property<br>
'<br>
MsgIndex = ctrl.List(iPtr)<br>
'<br>
End Function</font></tt> </p>
</blockquote>
<hr>
<p>Next you need a routine that takes the conversation index and returns the complete
internal message structure. Listing 10.8 shows you how to do this step. </p>
<hr>
<blockquote>
<b><p>Listing 10.8. Adding the <tt><font FACE="Courier">MsgPtr</font></tt> function.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Function MsgPtr(cIndex As String) As MsgType<br>
'<br>
' accepts conversation index, returns msg type<br>
'<br>
Dim x As Integer<br>
Dim y As Integer<br>
'<br>
y = UBound(MsgRec)<br>
'<br>
For x = 1 To y<br>
If MsgRec(x).ConvIndex = cIndex Then<br>
MsgPtr = MsgRec(x)<br>
Exit Function<br>
End If<br>
Next x<br>
'<br>
End Function</font></tt> </p>
</blockquote>
<hr>
<p>Finally, you can also use a function that returns the Message user-defined type based
on the direct pointer. Add the code from listing 10.9 to your project. </p>
<hr>
<blockquote>
<b><p>Listing 10.9. Adding the <tt><font FACE="Courier">GetMsgRec</font></tt> function.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Function GetMsgRec(iPointer As Integer) As MsgType<br>
'<br>
' accept pointer, return strucutre<br>
'<br>
<br>
'<br>
' start w blank records<br>
GetMsgRec.MsgID = ""<br>
GetMsgRec.ConvIndex = ""<br>
GetMsgRec.Subject = ""<br>
GetMsgRec.Topic = ""<br>
<br>
'<br>
' now try to find it<br>
If iPointer < 0 Or iPointer > UBound(MsgRec) Then<br>
MsgBox "Invalid Message
pointer!", vbExclamation, "GetMsgRec"<br>
Exit Function <br>
Else<br>
GetMsgRec = MsgRec(iPointer + 1)<br>
End If<br>
'<br>
End Function</font></tt> </p>
</blockquote>
<hr>
<p>While you're coding the message routines, add the <tt><font FACE="Courier">FillOutline</font></tt>
subroutine shown in Listing 10.10. This routine loads an outline control from the sorted
list. The outline can then be displayed to the user. </p>
<hr>
<blockquote>
<b><p>Listing 10.10. Adding the <tt><font FACE="Courier">FillOutline</font></tt> routine.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Sub FillOutline(ctrlIn As Control, ctrlOut As Control)<br>
'<br>
' accept a sorted list box as input<br>
' copy the recs to an outline w/ indents <br>
'<br>
Dim x As Integer<br>
Dim uMsg As MsgType<br>
'<br>
ctrlOut.Clear ' throw all the old stuff out<br>
'<br>
' load the outline in sorted order<br>
For x = 0 To ctrlIn.ListCount - 1<br>
uMsg = MsgPtr(ctrlIn.List(x)) <br>
ctrlOut.AddItem uMsg.Subject & "
(" & Format(uMsg.Date, "general date") & <font
FACE="ZAPFDINGBATS">Â</font>")" <br>
If bThreaded = True Then<br>
ctrlOut.Indent(x)
= Len(ctrlIn.List(x)) / 16<br>
End If<br>
Next x<br>
'<br>
' expand all nodes for viewing<br>
For x = 0 To ctrlOut.ListCount - 1<br>
If ctrlOut.HasSubItems(x) = True Then<br>
ctrlOut.Expand(x)
= True<br>
End If<br>
Next x<br>
'<br>
End Sub</font></tt> </p>
</blockquote>
<hr>
<p>The <tt><font FACE="Courier">FillOutline</font></tt> routine also makes sure threaded
messages are indented properly and expands the entire message tree for users to see the
various branches. </p>
<p>One more handy routine is the <tt><font FACE="Courier">MakeTimeStamp</font></tt>
function. This will be used to generate the <tt><font FACE="Courier">ConversationIndex</font></tt>
values. Add the code from Listing 10.11 to your project. </p>
<hr>
<blockquote>
<b><p>Listing 10.11. Adding the <tt><font FACE="Courier">MakeTimeStamp</font></tt>
routine.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Function MakeTimeStamp() As String <br>
'<br>
' create Exchange-type time stamp<br>
'<br>
Dim lResult As Long<br>
Dim lGuid As GUID<br>
'<br>
On Error GoTo LocalErr<br>
'<br>
lResult = CoCreateGuid(lGuid)<br>
If lResult = S_OK Then<br>
MakeTimeStamp = Hex$(lGuid.guid1) &
Hex$(lGuid.guid2)<br>
Else<br>
MakeTimeStamp = "00000000" '
zeroes<br>
End If<br>
Exit Function<br>
<br>
LocalErr:<br>
MsgBox "Error " & Str(Err) & ": "
& Error$(Err)<br>
MakeTimeStamp = "00000000"<br>
Exit Function<br>
'<br>
End Function</font></tt> </p>
</blockquote>
<hr>
<p>Only two routines remain: <tt><font FACE="Courier">OLEMAPIPostMsg</font></tt> and <tt><font
FACE="Courier">OLEMAPIReplyMsg</font></tt>. The <tt><font FACE="Courier">OLEMAPIPostMsg</font></tt>
routine builds and posts a new message thread to the target folder. Add the code from
Listing 10.12 to your project. </p>
<hr>
<blockquote>
<b><p>Listing 10.12. Adding the <tt><font FACE="Courier">OLEMAPIPostMsg</font></tt>
routine.<br>
</b></p>
</blockquote>
<blockquote>
<tt><font FACE="Courier"><p>Public Sub OLEMAPIPostMsg(cFolderName As String, cTopic As
String, cSubject As String, cBody As String) <br>
'<br>
' post a message to the folder (starts a new thread)<br>
'<br>
' --------------<br>
' Inputs:<br>
' cFolderName - name
of target folder<br>
' cTopic -
general discussion topic<br>
' cSubject -
user's subject line<br>
' cBody -
user's body text<br>
' --------------<br>
'<br>
Dim uFolder As FolderType<br>
'<br>
' get folder structure<br>
uFolder = GetFolderRec(cFolderName) ' get the structure<br>
If uFolder.FolderID = "" Then <br>
MsgBox "Unable to Locate
Folder!", vbExclamation, cFolderName<br>
Exit Sub<br>
End If<br>
'<br>
' open folder, store<br>
Set objFolder = objSession.GetFolder(uFolder.FolderID,
uFolder.StoreID)<br>
If objFolder Is Nothing Then<br>
MsgBox "Unable to open folder!",
vbExclamation, uFolder.Name<br>
Exit Sub<br>
End If<br>
'<br>
' create new message<br>
Set objMsg = objFolder.Messages.Add<br>
If objMsg Is Nothing Then<br>
MsgBox "Unable to create new message
in folder!", vbExclamation, <font FACE="ZAPFDINGBATS">Â</font>uFolder.Name <br>
Exit Sub<br>
End If<br>
'<br>
' fix up subject/topic<br>
If cTopic = "" And cSubject = "" Then<br>
cTopic = "Thread #" &
Format(Now(), "YYMMDDHHmm")<br>
End If<br>
'<br>
If cTopic = "" And cSubject <> "" Then<br>
cTopic = cSubject <br>
End If<br>
'<br>
If cSubject = "" And cTopic <> "" Then<br>
cSubject = cTopic <br>
End If<br>
'<br>
' now compose the message<br>
With objMsg<br>
'<br>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -