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 >
Wrap
Text File
|
1996-02-06
|
6KB
|
198 lines
LISTING 1.
'define what the keywords to look for
'in the subject line of the messages
Global Const RUNPROGRAM = "RUN PROGRAM"
Global Const DISPLAYATTACHMENT = "DISPLAY ATTACHMENT"
Global Const DISPLAYNOTIFICATION = "NOTIFY MESSAGE"
Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule As Integer)
Declare Function FindExecutable% Lib "shell.dll" (ByVal lpszFile$, ByVal lpsDir$, ByVal lpszResult$)
Sub ProcessMail
'read all unread mail and respond to
'mail needing processing
Dim stzType As String
Dim stzId As String
Dim ing As Integer, ingUnRead As Integer
MAPIMessages.FetchUnreadOnly = True
MAPIMessages.Action = 1
ingUnRead = MAPIMessages.MsgCount
While ingUnRead > 0
For ing = 0 To ingUnRead - 1
MAPIMessages.MsgIndex = ing
stzType = CheckType((MAPIMessages.MsgSubject))
If stzType > " " Then
ProcessMessage MAPIMessages, stzType, ing
ingUnRead = ingUnRead - 1
End If
Next ing
'check to see if any new mail recieved
MAPIMessages.FetchUnreadOnly = True
MAPIMessages.Action = 1
If MAPIMessages.MsgCount > ingUnRead Then
ingUnRead = MAPIMessages.MsgCount
Else
ingUnRead = 0
End If
WendEnd ProcessMail
Function CheckType (stzSubject as string) as string
If Instr(UCase(stzSubject),RUNPROGRAM) Then
CheckType = RUNPROGRAM
ElseIf Instr(UCase(stzSubject),DISPLAYNOTIFICATION) Then
CheckType = DISPLAYNOTIFICATON
ElseIf Instr(UCase(stzSubject),DISPLAYATTACHMENT) Then
CheckType = DISPLAYATTACHMENT
Else
CheckType = " "
Endif
End Function
Sub ProcessMessage(cntMailControl as control ,stzType as string, ingPos as integer)
'passed the type of mail,
'call the routine to process it
Select Case (stzType)
Case DISPLAYNOTIFATION
DisplayNotification cntMailControl, ingPos
Case RUNPROGRAM
RunProgram cntMailControl, ingPos
Case DISPLAYATTACHMENT
DisplayAttachment cntMailControl, ingPos
Case Else
MsgBox "Mail Type " & stzType & " is recognized _
but no routine exists to process it."
End Select
End If
LISTING 2.
Sub RunProgram (cntMail as control, ingPos as integer)
'passed a mail control, load the keywords
'array with the keyword to search for,
'get the name of the program and any parameters.
'check for special EXE's that require funny
'formatting of their command lines
Dim stzKeywords(4,2)
Dim stzCommandline as string
stzKeywords(1,1) = "Program:"
stzKeywords(2,1) = "Document:"
stzKeywords(3,1) = "Macro:"
stzKeywords(4,1) = "CommandLine:"
ParseKeywords stzKeywords(), cntMail.Text
If stzKeywords(1,2) > " " Then
If stzKeywords(2,2) > " " Then
stzCommandLine = stzKeywords(2,2)
Endif
If stzKeywords(3,2) > " " Then
If Instr(stzKeywords(1,2), "MSAccess.Exe") > 0 _
Then
stzCommandLine = stzCommandLine & "/X " & _
stzKeywords(3,2)
ElseIf Instr(stzKeywords(1,2), "WinWord.Exe") > _
0 Then
stzCommandLine = stzCommandLine & "/m" & _
stzKeywords(3,2)
ElseIf Instr(stzKeywords(1,2), "Excel.Exe") > 0 _
Then
SetExeclMacro stzKeywords(3,2), _
stzKeywords(2,2)
Else
stzCommandLine = stzCommandLine & " " _
& stzKeywords(3,2)
End If
Endif
If stzKeywords(4,2) > " " Then
If Instr(stzKeywords(1,2), "MSAccess.Exe") > 0 _
Then
stzCommandLine = stzCommandLine & "/C " & _
stzKeywords(4,2)
ElseIf Instr(stzKeywords(1,2), "WinWord.Exe") > _
0 Then
SetWordCommand stzKeywords(4,2) ,_
stzKeywords(2,2)
ElseIf Instr(stzKeywords(1,2), "Excel.Exe") > 0 _
Then
SetExcelCommand stzKeywords(4,2),_
stzKeywords(2,2)
Else
stzCommandLine = stzCommandLine & " " _
& stzKeywords(4,2)
End If
Endif
WaitForCompletion Shell(stzKeywords(1,2) & " " _
& stzCommandLine,4)
Endif
End Sub
Sub ParseText (stzKeywords() as string,stz as string)
' passed a 2-D array of keywords and a
' string, add the value found for the
' keyword to the array
Dim stzWork as string
Dim ing as integer
stzWork = Trim(stz)
For ing = 0 to UBound(stzKeywords())
ingWordPos = Instr(stzWork,stzKeywords(ing,1))
If ingWordPos > 0 Then
ingTabPos = Instr(ingWordPos,stzWork,Chr(9))
ingCRPos = Instr(ingWordPos,stzWork,Chr(13))
stzKeyWords(ing,2) = Mid$(stzWork,ingTabPos _
+ 1,ingCRPos-ingTabPos -1)
End If
Next ing
End Sub
Sub WaitForCompletion(ingTaskId as Integer)
Sub RunProgram(cntMail as Control)
'passed a taskid, do not return until one of
'the instances of the task's module stop
Dim ingInitialUsage As Integer
If ingTaskId <> 0 Then
ingInitialUsage = GetModuleUsage%(ingTaskId)
If ingInitialUsage > 0 Then
While GetModuleUsage%(ingTaskId) >= _
ingInitialUsage
DoEvents
Wend
End If
End If
End Sub
Listing 3
Sub DisplayAttachment (cntMail As Control, ingPos _
As Integer)
Dim stzAttachment As String, stzDefaultDir As String
Dim stzExecutable As String * 128
Dim ingResult As Integer
Dim obj As object
Dim ingEndPos As Integer
cntMail.MsgIndex = ingPos
stzAttachment = cntMail.AttachmentPathName
stzDefaultDir = "C:\"
ingResult = FindExecutable%(stzAttachment, _
stzDefaultDir, stzExecutable)
If ingResult > 32 Then
ingEndPos = InStr(stzExecutable, ".EXE")
ingResult = Shell(Left$(stzExecutable, ingEndPos + _
3) & " " & stzAttachment & Mid$(stzExecutable, _
ingEndPos + 4, 20), 1)
Else
MsgBox "Unable to find program to open " & _
stzAttachment & "."
End If
End Sub
Sub SetExcelCommand (stzCommandLine as string, _
stzDocument as string)
Dim obj As object
Set obj = CreateObject("Excel.Application.5")
obj.workbooks.open stzDocument
obj.Range("Command").value = stzCommandLine
obj.activeworkbook.[Close] True
obj.quit
Set obj = Nothing
End Sub
Sub SetWordCommand (stzCommandLine as string, _
stzDocument as string)
Dim obj As object
Set obj = CreateObject("word.basic")
obj.fileopen stzDocument
obj.setdocumentvar "Command", stzCommandLine
obj.fileclose 1
Set obj = Nothing
End Sub