home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD33342102000.psc / Sample / mdlMain.bas < prev   
Encoding:
BASIC Source File  |  2000-02-10  |  4.0 KB  |  175 lines
  1. Attribute VB_Name = "mdlMain"
  2. Option Explicit
  3.  
  4. Public oMail As Object
  5. Public oSend As Object
  6. Public oReceive As Object
  7. Public MainForm As frmMain
  8. Public LoginForm As frmLogin
  9. Public Continue As Integer
  10. Public ErrCode As Long
  11. Public ErrMsg As String
  12.  
  13. Public Sub Main()
  14.     
  15.     On Local Error GoTo ReportError
  16.     
  17.     Set oMail = CreateObject("MAPIMail.cMAPI")
  18.     Set oSend = oMail.Sender
  19.     Set oReceive = oMail.Receiver
  20.     
  21.     Set LoginForm = New frmLogin
  22.     LoginForm.Show
  23.     
  24.     Do While Continue = 0
  25.         DoEvents
  26.     Loop
  27.     
  28.     Select Case Continue
  29.     Case 1      'Canceled
  30.         ErrCode = 1001
  31.         ErrMsg = "Login canceled..."
  32.         GoTo ReportError
  33.     Case 2      'Failed
  34.         GoTo ReportError
  35.     Case Else   'Passed
  36.         Set MainForm = New frmMain
  37.         MainForm.Show
  38.     End Select
  39.     
  40.     Exit Sub
  41.     
  42. ReportError:
  43.     If ErrCode = 0 Then
  44.         ErrCode = Err.Number
  45.         ErrMsg = Err.Description
  46.     End If
  47.     MsgBox "Error: " & ErrCode & " - " & ErrMsg, _
  48.            vbCritical + vbOKOnly, "Load Error"
  49.     End
  50. End Sub
  51.  
  52. Public Function GetMail(EMList As MSFlexGrid, OnlyNew As Boolean, _
  53.                         ErrCode As Long, ErrMsg As String) As Boolean
  54.                         
  55.     Dim x As Long
  56.     Dim y As Integer
  57.     Dim RcdMessages As Variant
  58.     
  59.     On Local Error GoTo ReportError
  60.     
  61.     Screen.MousePointer = vbHourglass
  62.     
  63.     If Not oReceive.ReceiveMail(ErrCode, ErrMsg) Then
  64.         GoTo ReportError
  65.     End If
  66.     
  67.     RcdMessages = oReceive.RcdMessages
  68.     For x = 0 To oReceive.MessageCount - 1
  69.         EMList.Rows = x + 2
  70.         EMList.Row = x + 1
  71.         EMList.Col = 0
  72.         EMList.Text = RcdMessages(0, x) 'From
  73.         EMList.Col = 1
  74.         EMList.Text = Format(RcdMessages(1, x), "MM/DD/YYYY  HH:mm AM/PM") 'Date
  75.         EMList.Col = 2
  76.         EMList.Text = RcdMessages(2, x) 'Subject
  77.     Next
  78.     
  79.     GetMail = True
  80.     Screen.MousePointer = vbArrow
  81.     Exit Function
  82.     
  83. ReportError:
  84.     GetMail = False
  85.     Screen.MousePointer = vbArrow
  86.     If ErrCode = 0 Then
  87.         ErrCode = Err.Number
  88.         ErrMsg = Err.Description
  89.     End If
  90.     Exit Function
  91. End Function
  92.  
  93. Public Function IsArrayEmpty(tArray As Variant) As Boolean
  94.     Dim tFlag As Boolean
  95.     
  96.     On Local Error GoTo ReportError
  97.     tFlag = IsNumeric(UBound(tArray))
  98.     If tFlag Then
  99.         IsArrayEmpty = False
  100.     Else
  101.         IsArrayEmpty = True
  102.     End If
  103.     Exit Function
  104.     
  105. ReportError:
  106.     IsArrayEmpty = True
  107.     Exit Function
  108. End Function
  109.  
  110. Public Function GetNamePart(strIn As String) As String
  111.   
  112.   Dim intCounter As Integer
  113.   Dim strTmp As String
  114.  
  115.   On Error GoTo PROC_ERR
  116.   
  117.   ' Parse the string
  118.   For intCounter = Len(strIn) To 1 Step -1
  119.     ' It its a slash, grab the sub string
  120.     If Mid$(strIn, intCounter, 1) <> "\" Then
  121.       strTmp = Mid$(strIn, intCounter, 1) & strTmp
  122.     Else
  123.       Exit For
  124.     End If
  125.   Next intCounter
  126.  
  127.   ' Return the value
  128.   GetNamePart = strTmp
  129.   
  130. PROC_EXIT:
  131.   Exit Function
  132.   
  133. PROC_ERR:
  134.   MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  135.     "GetNamePart"
  136.   Resume PROC_EXIT
  137.  
  138. End Function
  139.  
  140. Public Function SendMail(SendTo As String, CC As String, Subject As String, _
  141.                          Message As String, Attachments As Variant, ErrCode As Long, _
  142.                          ErrMsg As String) As Boolean
  143.                          
  144.     Dim Destination As String
  145.     
  146.     On Local Error GoTo ReportError
  147.     
  148.     If CC <> "" Then
  149.         Destination = SendTo & ";" & CC
  150.     Else
  151.         Destination = SendTo
  152.     End If
  153.     
  154.     oSend.SendTo = Destination
  155.     oSend.Subject = Subject
  156.     oSend.Message = Message
  157.     oSend.FileName = Attachments
  158.     
  159.     If Not oSend.SendMail(ErrCode, ErrMsg) Then
  160.         GoTo ReportError
  161.     End If
  162.     
  163.     SendMail = True
  164.     Exit Function
  165.     
  166. ReportError:
  167.     SendMail = False
  168.     If ErrCode = 0 Then
  169.         ErrCode = Err.Number
  170.         ErrMsg = Err.Description
  171.     End If
  172.     Exit Function
  173. End Function
  174.  
  175.