home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2002 September / PCPlus_193_Laplink2000.iso / Helpdesk / copyhelp.exe / DemoCode.bas next >
Encoding:
BASIC Source File  |  2002-05-17  |  2.9 KB  |  93 lines
  1. Attribute VB_Name = "DemoCode"
  2. Option Explicit
  3.  
  4. ' Bare bones of a roll-your-own forwarding mechanism
  5. Sub DemoA()
  6. Dim olMsg1 As MailItem, olMsg2 As MailItem
  7.     If ActiveExplorer.Selection.Count <> 1 Then Exit Sub
  8.     Set olMsg1 = ActiveExplorer.Selection.Item(1)
  9.     Set olMsg2 = Application.CreateItem(olMailItem)
  10.     With olMsg2
  11.         .Subject = "Re: " + olMsg1.Subject
  12.         .Body = "From: " + olMsg1.SenderName + vbNewLine
  13.         .Body = .Body + "To: " + olMsg1.To + vbNewLine
  14.         .Body = .Body + vbNewLine + olMsg1.Body
  15.         .Display
  16.     End With
  17. End Sub
  18.  
  19. ' Basic version of Forward method followed by manipulation of the Body property
  20. Sub DemoB()
  21. Dim olMsg As MailItem
  22. Dim i1 As Integer, i2 As Integer
  23.  
  24.     If ActiveExplorer.Selection.Count <> 1 Then Exit Sub
  25.     Set olMsg = ActiveExplorer.Selection.Item(1).Forward
  26.         
  27.     With olMsg
  28.         i1 = InStr(.Body, "[mailto:")
  29.         i2 = InStr(i1 + 7, .Body, vbNewLine)
  30.         .Body = Left$(.Body, i1 - 1) + Right$(.Body, Len(.Body) - i2 + 1)
  31.                 
  32.         i1 = InStr(.Body, "From:")
  33.         i2 = InStr(i1 + 5, .Body, vbNewLine)
  34.         i1 = InStr(i1 + 5, .Body, "@")
  35.         If i1 > 0 And i1 < i2 Then
  36.             .Body = Left$(.Body, i1 - 1) + Right$(.Body, (Len(.Body) - i2) + 1)
  37.         End If
  38.                 
  39.         i1 = InStr(.Body, "To:")
  40.         i2 = InStr(i1 + 3, .Body, vbNewLine)
  41.     
  42.         .Body = Left$(.Body, i1 + 2) + " Steve" + Right$(.Body, Len(.Body) - i2 + 1)
  43.         
  44.         .Display
  45.     End With
  46. End Sub
  47.  
  48. ' Improved version tries to deal intelligently with HTML mail
  49. Sub DemoC()
  50. Dim olMsg As MailItem
  51. Dim strBody As String
  52. Dim i1 As Integer, i2 As Integer
  53. Dim strNewLine As String
  54.  
  55.     If ActiveExplorer.Selection.Count <> 1 Then Exit Sub
  56.     Set olMsg = ActiveExplorer.Selection.Item(1).Forward
  57.     
  58.     If olMsg.HTMLBody <> "" Then
  59.         strBody = olMsg.HTMLBody
  60.         strNewLine = "<BR>"
  61.     Else
  62.         strBody = olMsg.Body
  63.         strNewLine = vbNewLine
  64.     End If
  65.     '''''''''''''''''''''''''''''''''''''''''''''''
  66.     
  67.     i1 = InStr(strBody, "[mailto:")
  68.     i2 = InStr(i1 + 7, strBody, strNewLine)
  69.     strBody = Left$(strBody, i1 - 1) + Right$(strBody, Len(strBody) - i2 + 1)
  70.             
  71.     i1 = InStr(strBody, "From:")
  72.     i2 = InStr(i1 + 5, strBody, strNewLine)
  73.     i1 = InStr(i1 + 5, strBody, "@")
  74.     If i1 > 0 And i1 < i2 Then
  75.         strBody = Left$(strBody, i1 - 1) + Right$(strBody, (Len(strBody) - i2 + 1))
  76.     End If
  77.             
  78.     i1 = InStr(strBody, "To:")
  79.     i2 = InStr(i1 + 3, strBody, strNewLine)
  80.  
  81.     strBody = Left$(strBody, i1 + 2) + " Steve" + Right$(strBody, Len(strBody) - i2 + 1)
  82.     
  83.     '''''''''''''''''''''''''''''''''''''''''''''''
  84.     If olMsg.HTMLBody <> "" Then
  85.         olMsg.HTMLBody = strBody
  86.     Else
  87.         olMsg.Body = strBody
  88.     End If
  89.     
  90.     olMsg.Display
  91. End Sub
  92.  
  93.