home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Software Sampler / Visual_Basic_Software_Sampler_Visual_Basic_Programmers_Journal_June_1996.iso / issues / 03mar96 / code / p69lst1.txt < prev    next >
Text File  |  1996-02-06  |  6KB  |  198 lines
  1. LISTING 1.
  2.  
  3. 'define what the keywords to look for 
  4. 'in the subject line of the messages
  5. Global Const RUNPROGRAM = "RUN PROGRAM"
  6. Global Const DISPLAYATTACHMENT = "DISPLAY ATTACHMENT"
  7. Global Const DISPLAYNOTIFICATION = "NOTIFY MESSAGE"
  8. Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule As Integer)
  9. Declare Function FindExecutable% Lib "shell.dll" (ByVal lpszFile$, ByVal lpsDir$, ByVal lpszResult$)
  10. Sub ProcessMail
  11. 'read all unread mail and respond to 
  12. 'mail needing processing
  13. Dim stzType As String
  14. Dim stzId As String
  15. Dim ing As Integer, ingUnRead As Integer
  16.  
  17. MAPIMessages.FetchUnreadOnly = True
  18. MAPIMessages.Action = 1
  19. ingUnRead = MAPIMessages.MsgCount
  20. While ingUnRead > 0
  21.     For ing = 0 To ingUnRead - 1
  22.         MAPIMessages.MsgIndex = ing
  23.         stzType = CheckType((MAPIMessages.MsgSubject))
  24.          If stzType > " " Then
  25.             ProcessMessage MAPIMessages, stzType, ing
  26.             ingUnRead = ingUnRead - 1
  27.          End If
  28.     Next ing
  29.     'check to see if any new mail recieved
  30.     MAPIMessages.FetchUnreadOnly = True
  31.     MAPIMessages.Action = 1
  32.     If MAPIMessages.MsgCount > ingUnRead Then
  33.         ingUnRead = MAPIMessages.MsgCount
  34.     Else
  35.         ingUnRead = 0
  36.     End If
  37. WendEnd ProcessMail
  38. Function CheckType (stzSubject as string) as string
  39. If Instr(UCase(stzSubject),RUNPROGRAM) Then
  40.     CheckType =  RUNPROGRAM
  41. ElseIf Instr(UCase(stzSubject),DISPLAYNOTIFICATION) Then
  42.     CheckType =  DISPLAYNOTIFICATON
  43. ElseIf Instr(UCase(stzSubject),DISPLAYATTACHMENT) Then
  44.     CheckType = DISPLAYATTACHMENT
  45. Else
  46.     CheckType = " "
  47. Endif
  48. End Function
  49. Sub ProcessMessage(cntMailControl as control ,stzType as string, ingPos as integer)
  50. 'passed the type of mail, 
  51. 'call the routine to process it
  52. Select Case (stzType)
  53.     Case DISPLAYNOTIFATION
  54.         DisplayNotification cntMailControl, ingPos
  55.     Case RUNPROGRAM
  56.         RunProgram cntMailControl, ingPos
  57.     Case DISPLAYATTACHMENT
  58.         DisplayAttachment cntMailControl, ingPos
  59.     Case Else
  60.         MsgBox "Mail Type " & stzType & " is recognized _
  61.             but no routine exists to process it."
  62. End Select
  63. End If
  64.  
  65. LISTING 2.
  66. Sub RunProgram (cntMail as control, ingPos as integer)
  67. 'passed a mail control, load the keywords
  68. 'array with the keyword to search for,
  69. 'get the name of the program and any parameters.
  70. 'check for special EXE's that require funny 
  71. 'formatting of their command lines
  72. Dim stzKeywords(4,2)
  73. Dim stzCommandline as string
  74. stzKeywords(1,1) = "Program:"
  75. stzKeywords(2,1) = "Document:"
  76. stzKeywords(3,1) = "Macro:"
  77. stzKeywords(4,1) = "CommandLine:"
  78. ParseKeywords stzKeywords(), cntMail.Text
  79. If stzKeywords(1,2) > " " Then
  80.     If stzKeywords(2,2) > " " Then
  81.         stzCommandLine = stzKeywords(2,2)
  82.     Endif
  83.     If stzKeywords(3,2) > " " Then
  84.         If Instr(stzKeywords(1,2), "MSAccess.Exe") > 0 _
  85.             Then 
  86.             stzCommandLine = stzCommandLine  & "/X " & _
  87.                 stzKeywords(3,2)
  88.         ElseIf Instr(stzKeywords(1,2), "WinWord.Exe") > _
  89.             0 Then
  90.             stzCommandLine = stzCommandLine  & "/m" & _
  91.                 stzKeywords(3,2)
  92.         ElseIf Instr(stzKeywords(1,2), "Excel.Exe") > 0 _
  93.             Then
  94.             SetExeclMacro stzKeywords(3,2), _
  95.                 stzKeywords(2,2)
  96.         Else
  97.             stzCommandLine = stzCommandLine  & " " _
  98.                 & stzKeywords(3,2)
  99.         End If
  100.     Endif
  101.     If stzKeywords(4,2) > " " Then
  102.         If Instr(stzKeywords(1,2), "MSAccess.Exe") > 0 _
  103.             Then
  104.             stzCommandLine = stzCommandLine  & "/C " & _
  105.                 stzKeywords(4,2)
  106.         ElseIf Instr(stzKeywords(1,2), "WinWord.Exe") > _
  107.             0 Then
  108.             SetWordCommand stzKeywords(4,2) ,_
  109.                 stzKeywords(2,2)
  110.         ElseIf Instr(stzKeywords(1,2), "Excel.Exe") > 0 _
  111.             Then
  112.             SetExcelCommand stzKeywords(4,2),_
  113.                 stzKeywords(2,2)
  114.         Else
  115.             stzCommandLine = stzCommandLine  & " " _
  116.                 & stzKeywords(4,2)
  117.         End If
  118.     Endif
  119.     WaitForCompletion Shell(stzKeywords(1,2) & " " _
  120.         & stzCommandLine,4)
  121. Endif
  122. End Sub 
  123. Sub ParseText (stzKeywords() as string,stz as string)
  124. ' passed a 2-D array of  keywords and a
  125. ' string, add the value found for the
  126. ' keyword to the array
  127. Dim stzWork as string
  128. Dim ing as integer
  129. stzWork = Trim(stz)
  130. For ing = 0 to UBound(stzKeywords())
  131.     ingWordPos = Instr(stzWork,stzKeywords(ing,1))
  132.     If ingWordPos > 0 Then
  133.         ingTabPos = Instr(ingWordPos,stzWork,Chr(9))
  134.         ingCRPos = Instr(ingWordPos,stzWork,Chr(13))
  135.         stzKeyWords(ing,2) = Mid$(stzWork,ingTabPos _
  136.             + 1,ingCRPos-ingTabPos -1)
  137.     End If
  138. Next ing
  139. End Sub
  140. Sub WaitForCompletion(ingTaskId as Integer)
  141. Sub RunProgram(cntMail as Control)
  142. 'passed a taskid, do not return until one of
  143. 'the instances of the task's module stop
  144. Dim ingInitialUsage As Integer
  145. If ingTaskId <> 0 Then
  146.     ingInitialUsage = GetModuleUsage%(ingTaskId)
  147.     If ingInitialUsage > 0 Then
  148.         While GetModuleUsage%(ingTaskId) >= _
  149.             ingInitialUsage
  150.             DoEvents
  151.         Wend
  152.     End If
  153. End If
  154. End Sub
  155.  
  156. Listing 3
  157. Sub DisplayAttachment (cntMail As Control, ingPos _
  158.     As Integer)
  159. Dim stzAttachment As String, stzDefaultDir As String
  160. Dim stzExecutable As String * 128
  161. Dim ingResult As Integer
  162. Dim obj As object
  163. Dim ingEndPos As Integer
  164. cntMail.MsgIndex = ingPos
  165. stzAttachment = cntMail.AttachmentPathName
  166. stzDefaultDir = "C:\"
  167. ingResult = FindExecutable%(stzAttachment, _
  168.     stzDefaultDir, stzExecutable)
  169. If ingResult > 32 Then
  170.     ingEndPos = InStr(stzExecutable, ".EXE")
  171.     ingResult = Shell(Left$(stzExecutable, ingEndPos + _
  172.         3) & " " & stzAttachment & Mid$(stzExecutable, _
  173.         ingEndPos + 4, 20), 1)
  174. Else
  175.     MsgBox "Unable to find program to open " & _
  176.         stzAttachment & "."
  177. End If
  178. End Sub
  179. Sub SetExcelCommand (stzCommandLine as string, _
  180.     stzDocument as string)
  181. Dim obj As object
  182. Set obj = CreateObject("Excel.Application.5")
  183. obj.workbooks.open stzDocument
  184. obj.Range("Command").value = stzCommandLine
  185. obj.activeworkbook.[Close] True
  186. obj.quit
  187. Set obj = Nothing
  188. End Sub
  189. Sub SetWordCommand (stzCommandLine as string, _
  190.     stzDocument as string)
  191. Dim obj As object
  192. Set obj = CreateObject("word.basic")
  193. obj.fileopen stzDocument
  194. obj.setdocumentvar "Command", stzCommandLine
  195. obj.fileclose 1
  196. Set obj = Nothing
  197. End Sub
  198.