Отправка почты с аттачментом из VB-приложения

'***************************************************************
'Windows API/Global Declarations for :SendMail
'***************************************************************
		
Source Code:
Note:This code is formatted to be pasted directly into VB.
Pasting it into other editors may or may not work.

'***************************************************************
' Name: SendMail
' Description:This routine Sends mail with attachment to anybody 
'     you specify
' By: Whatever
'
'
' Inputs:From : Sender (your profile)
To: Recipient


Subject: 


    Text: Text Body
    UI: 0=open Mail User Interfase
    Atta: Attachment (separated by ;)
'
' Returns:None
'
'Assumes:None
'
'Side Effects:Be aware of passing all the parameters with data 
'(atta is aptional)
'
'Code provided by Planet Source Code(tm) (http://www.PlanetSource
'     Code.com) 'as is', without warranties as to performance, fitness,
'     merchantability,and any other warranty (whether expressed or
'     implied).
'***************************************************************




Sub MSnAB(FromName As String, ToName As String, Subject As String, _
 Text As String, UI As Integer, Atta As String)

    Dim Count As Integer
    Static Address(0 To 30) As String
    On Error Goto MAILERROR
    MAPIAUX.MSESS.UserName = FromName
    MAPIAUX.MSESS.SignOn
    MAPIAUX.MMSG.SessionID = MAPIAUX.MSESS.SessionID
    MAPIAUX.MMSG.Compose
    Call ParseAddress(ToName, Count, Address())


    For I = 0 To Count - 1
        MAPIAUX.MMSG.RecipIndex = I
        MAPIAUX.MMSG.RecipType = mapToList
        MAPIAUX.MMSG.RecipDisplayName = Address(I)
        MAPIAUX.MMSG.ResolveName
    Next I

    MAPIAUX.MMSG.MsgSubject = Subject
    MAPIAUX.MMSG.MsgNoteText = Text & Chr$(13)


    If Trim$(Atta)<> "" And Dir(Trim$(Atta)) <>"" Then
        MAPIAUX.MMSG.AttachmentIndex =MAPIAUX.MMSG.AttachmentCount
        MAPIAUX.MMSG.AttachmentType = 0
        MAPIAUX.MMSG.AttachmentPathName = Trim$(Atta)
        MAPIAUX.MMSG.AttachmentPosition = Len(Text)
    End If



    If UI <> 0 Then
        MAPIAUX.MMSG.Send
    Else
        MAPIAUX.MMSG.Send True
    End If

    MAPIAUX.MSESS.SignOff
    Exit Sub
    MAILERROR:
    c = Err
    B = Error$
    MsgBox " Mail Function Error " & Error$
    MAPIAUX.MSESS.SignOff
End Sub



Sub ParseAddress (ANames As String, Count As Integer, Addrs() As String)

    Dim CPos As Integer
    Dim VPos As Integer
    Dim SPos As Integer
    I = 0
    SPos = 1
    CPos = 0


    Do
        CPos = InStr(ANames, ";")
        If CPos = 0 Then VPos = Len(ANames) + 1 Else VPos = CPos
        Addrs(I) = Mid$(ANames, SPos, VPos - SPos)
        I = I + 1
        ANames = Right$(ANames, Len(ANames) - CPos)
    Loop While CPos > 0

    Count = I
End Sub