home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 May / PCP163A.iso / handson / files / copyhelp.exe / Outlook / ProcessWebFeedback.cls next >
Encoding:
Visual Basic class definition  |  2000-02-06  |  4.0 KB  |  109 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ProcessWebFeedback"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Public myOlApp As Outlook.Application
  11. Attribute myOlApp.VB_VarHelpID = -1
  12. Public WithEvents myOlItems As Outlook.Items
  13. Attribute myOlItems.VB_VarHelpID = -1
  14. Private Sub Class_Initialize()
  15. ' Initialise event handler
  16.  
  17. ' You can change the folder name in the next line if you want to
  18. Const NameOfFolder As String = "Web site feedback"
  19.  
  20.     Set myOlApp = CreateObject("Outlook.Application")
  21.     Set myOlItems = _
  22.     myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders.Item(NameOfFolder).Items
  23. End Sub
  24. Private Sub myOlItems_ItemAdd(ByVal Item As Object)
  25.  
  26. ' Adds the content of the first attachment to the body of
  27. ' the message (if attachment is text)and then deletes first
  28. ' attachment from message. Assumes format of message is:
  29. ' name=Eric+Smith&email=esmith@flobadob.co.uk&comments=Here+is+an+email+sent+from+a+form+on+my+Web+site
  30. ' ...and pretties it for easier reading
  31.  
  32. Dim myAttachments As Attachments
  33. Dim i, t As Long
  34. Dim ReadStatus As Boolean
  35. Dim AttachmentFileName, TempString1, TempString2 As String
  36. Dim Replacements() As Variant
  37.                     '    "Search for", "replace with"
  38.     Replacements = Array("+", " ", _
  39.                         "%2b", "+", _
  40.                         "name=", "NAME: ", _
  41.                         "&email=", vbCr + "EMAIL: ", _
  42.                         "&comments=", vbCr + "COMMENTS" + vbCr)
  43.  
  44.     ' Get handle on Attachments object
  45.     Set myAttachments = Item.Attachments
  46.     
  47.     ' Error checking - make sure only one attachment...
  48.     If myAttachments.Count <> 1 Then
  49.         MsgBox ("Message not processed - require exactly one attachment")
  50.         Exit Sub
  51.     End If
  52.     ' ...and that it's called POSTDATA.ATT
  53.     If UCase(myAttachments.Item(1).DisplayName) <> "POSTDATA.ATT" Then
  54.         MsgBox ("Message not processed - attachment must be called POSTDATA.ATT")
  55.         Exit Sub
  56.     End If
  57.        
  58.      ' Seem only to be able to modify message if it is opened
  59.     ReadStatus = Item.UnRead
  60.     Item.Display
  61.        
  62.     ' Save attachment to disk in C:\
  63.     AttachmentFileName = "C:\" & myAttachments.Item(1).DisplayName
  64.     myAttachments.Item(1).SaveAsFile AttachmentFileName
  65.             
  66.     ' Open attachment file and read its contents into TempString1
  67.     Open AttachmentFileName For Input As #1
  68.     TempString1 = "***** ATTACHMENT CONTENT *****" + vbCr
  69.     
  70.     Do While Not EOF(1)
  71.         Line Input #1, TempString2
  72.         TempString1 = TempString1 + TempString2
  73.     Loop
  74.     
  75.     Close #1                ' Close disk file
  76.     Kill AttachmentFileName ' And delete it
  77.     
  78.     ' Now process contents of TempString1
  79.     ' Loop for each pair of find/replace items in Replacements array...
  80.     For i = LBound(Replacements) To UBound(Replacements) Step 2
  81.         ' Cater for multiple finds (e.g. all those + symbols)
  82.         Do While True ' Would loop forever, but...
  83.             t = InStr(UCase(TempString1), UCase(Replacements(i)))
  84.             If t = 0 Then Exit Do ' ...quits loop when no more found
  85.             ' Otherwise splice replacement text into place
  86.             TempString1 = Left(TempString1, t - 1) + _
  87.                 Replacements(i + 1) + _
  88.                 Right(TempString1, Len(TempString1) - t - Len(Replacements(i)) + 1)
  89.         Loop
  90.     Next
  91.         
  92.      ' Add carriage return to existing body text, if there is any
  93.     If Item.Body <> "" Then Item.Body = Item.Body + vbCr
  94.     
  95.     ' Add attachment text to body
  96.     Item.Body = Item.Body + TempString1
  97.     
  98.     ' Delete attachment. Could remove this line of you want to play safe
  99.     myAttachments.Item(1).Delete
  100.  
  101.     ' Close message & save changes without prompting
  102.     Item.Close (olSave)
  103.     
  104.     ' Restore its original read/unread status
  105.     Item.UnRead = ReadStatus
  106.  
  107. End Sub
  108.  
  109.