Sända e-post från XL med arbetsbok som bilaga via Lotus Notes
Här demonstreras en teknik för att sända arbetsböcker som bilagor från XL via Lotus Notes.
Den första proceduren (se nedan) skapar menykommandot "Sänd via Lotus Notus" i menyn Arkiv | Skicka till. Proceduren därefter tar bort menyalternativet.
Huvudproceduren - SendToLotus - utför följande aktiviteter:
Kontrollera att den aktiva arbetsboken är sparad.
Kontrollera om användaren vill spara eventuella ändringar i den aktiva arbetsboken.
Visa dialogrutor där man fyller i mottagare och meddelandetext.
Skapa ärenderaden automatiskt.
Kontrollera om Lotus Notes är igång eller inte.
Skapa e-postmeddelandet, tilldela de inhämtade uppgifterna samt lägga till den aktiva arbetsboken som bilaga till meddelandet.
Sända e-postmeddelandet från Lotus Notes, spara det och meddela användaren att det är skickat.
Noterbart är att vi här använder oss av "Late binding".
Option Explicit
Sub Create_Lotus_Menu()
'© 2002 Alla rättigheter XL-Dennis
Dim cbNew As CommandBar
Dim bcSendTo As CommandBarControl
Dim bcLotus As CommandBarControl
Set bcSendTo = CommandBars.FindControl(Type:=msoControlPopup, ID:=30095)
Set cbNew = bcSendTo.CommandBar
Set bcLotus = cbNew.Controls.Add
With bcLotus
.BeginGroup = True
.Caption = "Sänd via Lotus Notes"
.FaceId = 719
.OnAction = "SendToLotus"
.Tag = "Lotus"
End With
End Sub
Sub Delete_Lotus_Menu()
'© 2002 Alla rättigheter XL-Dennis
Dim bcLotus As CommandBarControl
On Error Resume Next
Set bcLotus = CommandBars.FindControl(, , Tag:="Lotus")
bcLotus.Delete
End Sub
Sub SendToLotus()
'© 2002 Alla rättigheter XL-Dennis
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String, stTitle As String
Dim vaRecipient As Variant, vaMsg As Variant
Const EMBED_ATTACHMENT = 1454
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."
stAttachment = ActiveWorkbook.FullName
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
noDocument.PostedDate = Now()
noDocument.Send 0, vaRecipient
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
' Excel aktiveras och kontrollen återgår till Excel
AppActivate "Microsoft Excel"
MsgBox "E-postmeddelandet är skapat och har skickats iväg.", vbInformation
End Sub
Under vissa förhållanden kan vi få Excel att skicka arbetsböcker via Lotus Notes utan ovanstående lösning:
1. Öppna Internet Explorer.
2. Välj kommandot Verktyg | Internetalternativ... | Fliken Program.
3. För alternativet E-post anges Lotus Notes som standardprogram.
Ett stort tack till Peter Jansson för all testning och för idén till detta tips!Tipset är också publicerad i Mikrodatorn 2002 nr 12 varför engelska namn används för variablerna.