Realistically, solving the problem automating Word is the least of your
worries! As I've already pointed out, whatever you're currently doing using
Outlook likely can't be done using Outlook Express.
How have you declared objWord?
--
Doug Steele, Microsoft Access MVPhttp://I.Am/DougSteele
(no e-mails, please!)
- Show quoted text -
Hi
I have already done it using Outlook Express!!
Here is the code:
Option Compare Database
Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type
Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type
Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type
Declare Function MAPISendMail _
Lib "C:\Program Files\Outlook Express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long
Sub SendMailWithOE(ByVal vSubject As String, _
ByVal vMessage As String, _
ByRef vRecipients As String, _
Optional ByVal vFiles As String)
Dim aFiles() As String
Dim aRecips() As String
Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage
Dim z As Long
aFiles = Split(vFiles, ",")
ReDim FilePaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With FilePaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z
aRecips = Split(vRecipients, ",")
ReDim Recips(LBound(aRecips) To UBound(aRecips))
For z = LBound(aRecips) To UBound(aRecips)
With Recips(z)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
With Message
.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
.Files = VarPtr(FilePaths(LBound(FilePaths)))
.NoteText = vMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = vSubject
End With
MAPISendMail 0, 0, Message, 0, 0
End Sub
Sub Splitter()
Dim mask As String
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
mask = "ddMMyy"
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters + 1
DocName = "c:\temp\" & Format(Date, mask) & " " & LTrim$(Str$
(Counter))
ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, count:=1
.Delete Unit:=wdCharacter, count:=1
End With
ActiveDocument.SaveAs FileName:=DocName,
FileFormat:=wdFormatDocument
Call sendEMail(ActiveDocument)
ActiveWindow.Close
Counter = Counter + 1
Wend
End Sub
Sub sendEMail(MainDoc As Word.Document)
Dim fld As Word.Field
Dim emailTo As String
Dim Mess As String
Dim Subject As String
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
emailTo = Selection
emailTo = Left(emailTo, InStr(emailTo, " ") - 1) + Mid(emailTo,
InStr(emailTo, " ") + 1, 1) _
+ "@<domain.com>"
Mess = "Sending email to: " + emailTo
Subject = "Test"
SendMailWithOE Subject, Mess, emailTo, "C:/TEMP/Confirmation1.doc"
End Sub
Stapes
