Отправка почты с аттачментом из 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





к оглавлению
Используются технологии uCoz