VBA/Excel/Access/Word/Outlook/Email
Содержание
- 1 Adds an addressee, a subject, and body text; applies the HTML format; sets the importance to high; and sends the message:
- 2 Display the information in a list of mails
- 3 Searching for Items
- 4 Send a table through email
- 5 Send email by Using POP3
- 6 Send email for all records in an Access table
- 7 Sending a Message
- 8 Send out an email by using the DoCmd.SendObject
- 9 Using the CreateItem Method to Create Default Items
Adds an addressee, a subject, and body text; applies the HTML format; sets the importance to high; and sends the message:
<source lang="vb">
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 .Send End With
End Sub
</source>
Display the information in a list of mails
<source lang="vb">
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, ",") Loop
End Sub
</source>
Searching for Items
<source lang="vb">
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 Else Debug.Print "no messages that match the search criteria." End If
End Sub
</source>
Send a table through email
<source lang="vb">
Sub TestSendObject()
DoCmd.SendObject acSendTable, "tblEmployees", acFormatXLS, "someone@yahoo.ru", , , "Employee List", "For your review.", False
End Sub
</source>
Send email by Using POP3
<source lang="vb">
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 Next 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") myMailItem.Recipients.ResolveAll Set myMailItem.SendUsingAccount = oAccount myMailItem.Send End If
End Sub
</source>
Send email for all records in an Access table
<source lang="vb">
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 objEmail.Send rsContacts.MoveNext Loop
End Sub
</source>
Sending a Message
<source lang="vb">
Sub sendingmess()
Dim myMessage As MailItem Set myMessage = Application.CreateItem(ItemType:=olMailItem) myMessage.Send
End Sub
</source>
Send out an email by using the DoCmd.SendObject
<source lang="vb">
Sub SendEmail
DoCmd.SendObject acSendNoObject, , , "d@yahoo.ru", , , "This is cool!", "an email.", False
End Sub
</source>
Using the CreateItem Method to Create Default Items
<source lang="vb">
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." .Display End With
End Sub
</source>