Материал из VB Эксперт
Перейти к: навигация, поиск

Adds an addressee, a subject, and body text; applies the HTML format; sets the importance to high; and sends the message:

Sub message()
    Dim myMessage As MailItem
    Set myMessage = Application.CreateItem(ItemType:=olMailItem)
    With myMessage
        .To = "yourName@yourSite.ru"
        .Subject = "Preparation "
        .Body = "review."
        .BodyFormat = olFormatHTML
        .Importance = olImportanceHigh
    End With
End Sub

Display the information in a list of mails

Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim myMailItem As Object
    Dim intMsgIDStart As Integer, intMsgIDEnd As Integer
    Dim intCutPoint As String, strMailItemID As String
    intMsgIDStart = 1
    intCutPoint = Len(EntryIDCollection)
    intMsgIDEnd = InStr(intMsgIDStart, EntryIDCollection, ",")
    Do While intMsgIDEnd <> 0
        strMailItemID = Strings.Mid(EntryIDCollection, intMsgIDStart, _
            (intMsgIDEnd - intMsgIDStart))
        Set myMailItem = Application.Session.GetItemFromID(strMailItemID)
        Debug.Print myMailItem.Subject
        intMsgIDStart = intMsgIDEnd + 1
        intMsgIDEnd = InStr(intMsgIDStart, EntryIDCollection, ",")
End Sub

Searching for Items

Sub Sample_Advanced_Search()
    Dim mySearch As Search
    Dim myResults As Results
    Dim intCounter As Integer
    Set mySearch = AdvancedSearch(Scope:="Inbox",Filter:="urn:schemas:mailheader:subject = "Project"")
    Set myResults = mySearch.Results
    If myResults.Count > 0 Then
        Debug.Print "found"
    For intCounter = 1 To myResults.Count
        Debug.Print myResults.Item(intCounter).SenderName
    Next intCounter
        Debug.Print "no messages that match the search criteria."
    End If
End Sub

Send a table through email

Sub TestSendObject()
    DoCmd.SendObject acSendTable, "tblEmployees", acFormatXLS, "someone@yahoo.ru", , , "Employee List", "For your review.", False
End Sub

Send email by Using POP3

Public Sub SendUsingPOP3()
    Dim myMailItem As Outlook.MailItem
    Dim colAccounts As Outlook.Accounts
    Dim oNS As Outlook.NameSpace
    Dim oAccount As Outlook.Account
    Dim strUser As String
    Dim strAddress As String
    Dim strAccountName As String
    Dim blnFound As Boolean
    blnFound = False
    Set oNS = Application.GetNamespace("MAPI")
    Set colAccounts = oNS.Accounts
    For Each oAccount In colAccounts
        If oAccount.AccountType = OlAccountType.olPop3 Then
            strAddress = oAccount.SmtpAddress
            strUser = oAccount.UserName
            strAccountName = oAccount.DisplayName
            blnFound = True
            Exit For
        End If
    If blnFound Then
        Set myMailItem = Application.CreateItem(olMailItem)
        myMailItem.Subject = "Sent using: " & strAccountName
        myMailItem.Body = "Sent by " & strUser & vbCrLf & "Sent using the " & strAddress & " SMTP address."
        myMailItem.Recipients.Add ("test@test.ru")
        Set myMailItem.SendUsingAccount = oAccount
    End If
End Sub

Send email for all records in an Access table

Sub ControlOutlook()
    Dim objOutlook As New Outlook.Application
    Dim objEmail As Outlook.MailItem
    Dim strLtrContent As String
    Dim rsContacts As New ADODB.Recordset
    rsContacts.ActiveConnection = CurrentProject.Connection
    rsContacts.Open "tblContacts"
    Do While Not rsContacts.EOF
       strLtrContent = "Dear " & rsContacts("FirstName") & " "
       strLtrContent = strLtrContent & rsContacts("LastName") & ":" 
       Set objEmail = objOutlook.CreateItem(olMailItem)
       objEmail.Recipients.Add rsContacts("Email")
       objEmail.Subject = "Our address has changed."
       objEmail.Body = strLtrContent
End Sub

Sending a Message

Sub sendingmess()
    Dim myMessage As MailItem
    Set myMessage = Application.CreateItem(ItemType:=olMailItem)
End Sub

Send out an email by using the DoCmd.SendObject

Sub SendEmail
    DoCmd.SendObject acSendNoObject, , , "d@yahoo.ru", , , "This is cool!", "an email.", False
End Sub

Using the CreateItem Method to Create Default Items

Sub mail()
    Dim myMessage As MailItem
    Set myMessage = Application.CreateItem(ItemType:=olMailItem)
    With myMessage
        .To = "test@example.ru"
        .Subject = "Test message"
        .Body = "This is a test message."
    End With
End Sub