|
Вот как можно отправлять данный по мылу, про БД сам разбирись
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
Ответить
|
STEAM | ICQ: 276847102 
den2003