Sända cellområde som meddelande via Lotus Notes

 

I detta tips visas hur vi kan sända ett cellområde som meddelande i Lotus Notes, dvs som ett inbäddat objekt.

Noterbart är att vi här använder oss av "Late binding" men att vi måste ange en referens till Microsoft Form 2.0 Object Library.

Option Explicit  

Sub Sanda_CellOmrade_Lotus()

   '© 2002 Alla rättigheter XL-Dennis

   Dim noSession As Object, noDatabase As Object, noDocument As Object

   Dim stSubject As Variant, stTitle As String

   Dim vaRecipient As Variant, vaMsg As Variant

   Dim rnBody As Range

   Dim Data As DataObject

 

   stTitle = "Aktiv arbetsbok ej sparad"

 

        If Len(ActiveWorkbook.Path) = 0 Then

            MsgBox "Den aktiva arbetsboken måste sparas först innan " & vbCrLf _

            & "den kan bifogas som bilaga till e-post!.", vbInformation, stTitle

            Exit Sub

        End If

 

        If ActiveWorkbook.Saved = False Then

                 If MsgBox("Vill du spara gjorda ändringar innan utskick?", _

                    vbYesNo + vbInformation, stTitle) = vbYes Then _

                    ActiveWorkbook.Save

        End If

 

         Do

          vaRecipient = Application.InputBox( _

            Prompt:="Här anger du mottagarens mailadress ex.vis:" & vbCrLf _

            & "excel@microsoft.com eller bara namnet om det är internt.", _

            Title:="Mottagare", _

            Type:=2)

         Loop While vaRecipient = ""

         If vaRecipient = False Then Exit Sub

 

         Do

          vaMsg = Application.InputBox( _

               Prompt:="Här anges meddelandetext såsom:" & vbCrLf _

               & "Bifogat finner du veckorapporten.", _

               Title:="Meddelande", _

               Type:=2)

         Loop While vaMsg = ""

 

         stSubject = "Standardmeddelande, automatskickad fil."

 

         On Error Resume Next

         Set rnBody = Application.InputBox(Prompt:="Vänligen ange cellområdet som ska skickas:", _

               , Default:=Selection.Address, Type:= 8)

         If rnBody Is Nothing Then Exit Sub

         On Error GoTo 0

 

         Set noSession = CreateObject("Notes.NotesSession")

         Set noDatabase = noSession.GETDATABASE("", "")

 

         If noDatabase.IsOpen = False Then noDatabase.OPENMAIL  

         Set noDocument = noDatabase.CreateDocument

 

         'Här använder vi Windows urklipp-verktyg för att klistra in

         'det önskade cellområdet i e-postmeddelandet.

         rnBody.Copy

         Set Data = New DataObject

         Data.GetFromClipboard

 

         With noDocument

               .Form = "Memo"

               .SendTo = vaRecipient

               .Subject = stSubject

               .Body = Data.GetText  & vaMsg

               .SaveMessageOnSend = True

         End With

         noDocument.PostedDate = Now()

         noDocument.Send 0, vaRecipient

 

         Set noDocument = Nothing

         Set noDatabase = Nothing

         Set noSession = Nothing

 

         AppActivate "Microsoft Excel"

         Application.CutCopyMode = False  

         MsgBox "E-postmeddelandet är skapat och har skickats iväg.", vbInformation

       End Sub

 

Så här kan det färdiga resultatet se ut efter att ovanstående procedur har körts: