home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "Code"
- Option Explicit
- Dim ol As Outlook.Application
- Dim ns As Outlook.NameSpace
- Dim MsgText As String
- Public issueNumber As Integer
-
- Public Sub Main()
- Set ol = New Outlook.Application
- Set ns = ol.GetNamespace("MAPI")
- issueNumber = 159
-
- ns.Logon "", , True, True
- Call ReadFile
- MainForm.Show
-
- End Sub
- Public Sub SendAllMail()
-
- MainForm.Data1.Refresh
- With MainForm.Data1.Recordset
- While Not .EOF
- SendMail .Fields!Name, .Fields!EMail
- .MoveNext
- Wend
- End With
-
- End Sub
- Public Sub SendMail(n As String, dest As String)
- Dim newMail As Outlook.MailItem
-
-
- Set newMail = ol.CreateItem(olMailItem)
- With newMail
- .Subject = "PC Plus Knitting Circle News (September)"
- .Body = MsgText
- With .Recipients.Add(dest)
- .Type = olTo
- End With
- With .Attachments.Add _
- (App.Path & "\attachment.rtf", olByValue, 1, "The Winter Warmer")
- End With
- .Send
- End With
-
- With MainForm.Data2.Recordset
- .AddNew
- !Name = n
- !DateSent = Now
- !issueNumber = issueNumber
- .Update
- End With
- Set newMail = Nothing
-
- End Sub
- Private Sub ReadFile()
- Dim NextLine As String
-
- Open App.Path & "\news.txt" For Input As #1
- Do Until EOF(1)
- Line Input #1, NextLine
- MsgText = MsgText + NextLine + vbCrLf
- Loop
-
- End Sub
-