群发带附件的VBA程序

Sub emailmergewithattachments()
'
' emailmergewithattachments Macro
' 宏在 2007-9-28 由 longmb 创建
'
Dim Source As Document, Maillist As Document
Dim Datarange As Range
Dim Counter As Integer, i As Integer
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As String, message As String, title As String
 
Set Source = ActiveDocument
Set Text = Source.Content

'Selection.WholeStory
 '   Selection.Copy

 
' Check if Outlook is running.  If it is not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If