Ao send branch.mmbas

Option Explicit 'ao_send_branch 08Dec09 http://www.activityowner.com http://creativecommons.org/licenses/by-sa/3.0/ ' '08Dec09 testing addition of authentication option Sub Main Dim schema As String Dim objMessage As Object Dim configdocname As String Dim configdoc As Document Dim dashboarddoc As Document Dim t As Topic configdocname=GetPath(mmDirectoryMyMaps) & "\AO\emailconfig.mmap" Set dashboarddoc = ActiveDocument On Error GoTo X Set configdoc=Documents.Open(configdocname,"",False) On Error GoTo 0 If Err.Number>0 Then X: Set configdoc=Documents.Add configdoc.CentralTopic.Text="ao_send_branch.mmbas configuration file" End If createattribute "smtp",      "Enter your SMTP for your ISP (e.g. smtp.domain.com)", configdoc createattribute "fromemail", "Enter from address for outgoing email"			, configdoc createattribute "toemail",   "Enter to address for outgoing email"			, configdoc createattribute "serverport", "Enter port to use (25 typical, 465 for gmail)"	, configdoc createattribute "youruserid", "Enter your userid (only if authentication required)", configdoc createattribute "yourpassword", "Enter your password (only if authentication required)", configdoc createattribute "authenticate", "Enter 1 if you need to authenticate (otherwise enter 0)", configdoc configdoc.SaveAs(configdocname) dashboarddoc.Activate schema="http://schemas.microsoft.com/cdo/configuration/" Set objMessage = CreateObject("CDO.Message") ActiveDocument.Selection.PrimaryTopic.SetLevelOfDetail(10) ActiveDocument.Selection.Copy With objMessage .Subject = ActiveDocument.Selection.PrimaryTopic.Text .From = getattribute("fromemail",configdoc) .To =  getattribute("toemail",configdoc) .TextBody = Clipboard End With With objMessage.Configuration.Fields .Item(schema & "sendusing") = 2 .Item(schema & "smtpserver") = getattribute("smtp",configdoc) .Item(schema & "smtpserverport") = Eval(getattribute("serverport",configdoc)) .Item(schema & "smtpauthenticate") = Eval(getattribute("authenticate",configdoc)) If Not getattribute("yourpassword",configdoc)="" Then .Item(schema & "smtpauthenticate")= 1 'clear text .Item(schema & "sendusername") = getattribute("youruserid", configdoc) .Item(schema & "sendpassword") = getattribute("yourpassword",configdoc) .Item(schema & "smtpusessl") = True .Item(schema & "smtpconnectiontimeout")= Eval(getattribute("serverport",configdoc)) End If .Update End With On Error GoTo Y objMessage.send On Error GoTo 0 If Err.Number>0 Then Y: MsgBox("Error trying to send message via " & getattribute("smpt",configdoc) & ":" & Err.Description) End If configdoc.Close End Sub Function getattribute(a As String,d As Document) As String Dim mtopic As Topic For Each mtopic In d.CentralTopic.AllSubTopics If a=mtopic.Text Then getattribute = mtopic.Notes.Text Next End Function Sub createattribute(a As String,s As String, d As Document) Dim mtopic As Topic Dim atopic As Topic Dim found As Boolean found=False For Each mtopic In d.CentralTopic.AllSubTopics If a=mtopic.Text Then found=True Set atopic = mtopic End If   Next If Not found Then Set atopic=d.CentralTopic.AddSubTopic(a) atopic.Notes.Text=InputBox(s) End If End Sub