Option
Explicit
Public
Declare
Function
FindWindow
Lib
"user32"
Alias
"FindWindowA"
_
(ByVal
lpClassName
As
String,
_
ByVal
lpWindowName
As
String)
As
Long
Sub
Lotus_Formaterad_Cellområde()
'© 2003
Alla rättigheter XL-Dennis
Dim
oWorkSpace
As
Object,
oUIDoc
As
Object,
Notes
As
Object
Dim
stTo
As
String,
stCC
As
String,
stSubject
As
String,
stBody
As
String
Dim
rnBody
As
Range
Dim
lnRetVal
As
Long
'Kontroll om Lotus Notes är öppnad eller ej.
lnRetVal =
FindWindow("NOTES",
vbNullString)
If
lnRetVal =
0
Then
MsgBox
"För att
skapa det önskade e-postet måste Lotus Notes vara öppnat.",
_
vbInformation,
"Systemfel-Lotus
Notus"
Exit
Sub
End
If
Application.ScreenUpdating =
False
Set
oWorkSpace =
CreateObject("Notes.NotesUIWorkspace")
stTo
=
"Excel@Microsoft.com"
stCC
=
"Lotus
Notes@IBM.com"
stSubject =
"Veckorapport"
'För
att få en radbrytning i förhållande till den inklistrade bilden.
stBody = vbCrLf
&
"Enligt överenskommelse"
'Här
används ett namngivet cellområdet.
Set
rnBody = ActiveSheet.Range("rnbody")
rnBody.Copy
On
Error
Resume
Next
'Kontrollera dina inställningar enligt följande:
'Se
till att vyn Post är öppen.
'Server
ooch sökväg: Arkiv | Databas | Egenskaper
'Maildatabas:
Arkiv | Databas | Egenskaper
'Ändra
uppgifterna i följande sträng:
Set
oUIDoc = oWorkSpace.ComposeDocument("",
"mail\xldennis.nsf",
"Memo")
On
Error
GoTo
0
Set
oUIDoc = oWorkSpace.CurrentDocument
Call
oUIDoc.FieldSetText("EnterSendTo",
stTo)
Call
oUIDoc.FieldSetText("EnterCopyTo",
stCC)
Call
oUIDoc.FieldSetText("Subject",
stSubject)
Call
oUIDoc.FieldSetText("Body",
stBody)
Call
oUIDoc.GoToField("Body")
Call
oUIDoc.Paste
Call
oUIDoc.Send(False)
Call
oUIDoc.Save(True,
False,
False)
Set
oUIDoc =
Nothing
With
Application
.CutCopyMode
=
False
.ScreenUpdating
=
True
End
With
MsgBox
"E-post
har skapats,sparats men inte sänts iväg.",
vbInformation
AppActivate
("Notes")
End
Sub