Outlook 2007 SP2
Exchange 2007 SP1

I want to create a task with an formated hyperlink in the body.

At
Set objDoc = objInsp.WordEditor
always security boxes pop up !!!!! Why????

This is the Code:
Private Sub CreateNewTaskWithHyperlink()
Dim appOutLook As Outlook.Application
Dim taskOutLook As Outlook.TaskItem
Dim objInsp As Outlook.Inspector
Dim objSel As Word.Selection
Dim strLink As String
Dim strLinkText As String
Dim olAnw As Object
Dim docangebot As Word.Document
Set docangebot = ActiveDocument
'Only For test fix Hyperlink
strLink = "http://www.google.de"
strLinkText = "Googeln" '
'
On Error Resume Next
Set olAnw = GetObject(, "Outlook.Application")
On Error GoTo ErrorToDo
If olAnw Is Nothing Then
Dim wshShell As Object
Dim strPath As String
Dim strOpen As String
Const PATH =
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0 \Outlook\InstallRoot\Path"
Const APP = "Outlook.exe"
Set wshShell = CreateObject("WScript.Shell")
strPath = wshShell.RegRead(PATH)
strOpen = strPath & APP
Shell strOpen, vbMinimizedNoFocus
Set wshShell = Nothing
End If
Set appOutLook = CreateObject("Outlook.Application")
appOutLook.Session.Logon
Set taskOutLook = appOutLook.CreateItem(olTaskItem)
With taskOutLook
.Subject = "Test hyperlink"
.Importance = olImportanceNormal
'Only for test fix Date
.DueDate = "01.03.2010"
.StartDate = "01.03.2010"
.ReminderTime = "01.03.2010" & " " & "08:00"
'
.ReminderSet = True
Set objInsp = .GetInspector
' ?????????
Set objDoc = objInsp.WordEditor 'Programmatic Access Security
Check
'
Set objSel = objDoc.Windows(1).Selection
objDoc.Hyperlinks.Add objSel.Range, strLink, "", "", strLinkText,
""
Set objSel = objDoc.Windows(1).Selection
'Text before Hyperlink
With objSel
.Collapse wdCollapseStart
.InsertBefore "Das ist der Link zum "
End With
'Text after Hyperlink
Set objSel = objDoc.Windows(1).Selection
With objSel
.Collapse wdCollapseStart
.MoveEnd WdUnits.wdStory, 1
.Select
.InsertAfter " Viel Spass! "
End With
.Importance = olImportanceHigh
.Save
End With
ErrorExit:
Set taskOutLook = Nothing
Set appOutLook = Nothing
Exit Sub
ErrorToDo:
Select Case Err.Number
Case 13
Resume ErrorExit
Case 287
Resume ErrorExit
Case Else
MsgBox Err.Number & ";" & Err.Description
End Select
End Sub

Without WordEditor the code runs without security pop up:

Set appOutLook = CreateObject("Outlook.Application")
appOutLook.Session.Logon
Set taskOutLook = appOutLook.CreateItem(olTaskItem)
With taskOutLook
.Subject = "Test hyperlink"
.Importance = olImportanceNormal
.DueDate = "01.03.2010"
.StartDate = "01.03.2010"
.ReminderTime = "01.03.2010" & " " & "08:00"
.ReminderSet = True
.Body = "Das ist der Link zum " & "http://www.google.at" & " Viel
Spass!"
.Importance = olImportanceHigh
.Save
End With


Reinfried