hello,

I've written a small macro that starts up an addin (DesktopSMS) on the main
window toolbar from a contact form. I had to do it that way because the
addin does not provide programmatic access... :-(

anyway..
I found that the first time I start the macro after starting outlook takes
ages (3-5 minutes) and hangs OL2007 during this waiting time. however,
subsequent starts afterwards are very fast.

(I also noticed that starting the macro editior with Alt-F11 alse takes a
lot of time, though I do not know if that is related. though, after starting
the macro editor at least once, also the macro I mentioned above starts fast
the first time)

anyone can tell me how to speed up the first execution of that macro?
frankly, I am not sure that the problem is with the script.. could it be
that I have a corrupt VBAProject.otm?




the code is very simple. I'm calling DSMS_form() only from a contact form.
It grabs the mobile number from the contact, puts it on the clipboard
(because I did not find another way to send it to the DesktopSMS form
afterwards), then pushes the button DesktopSMS on the main window. I am
using another software to paste the clipboard back to the DesktopSMS form.
I know it would be more elegant to do everything in VBA, but I was simply
not finding a way to access the DesktopSMS addin directly..


Function GetCurrentItem() As Object
Dim objApp As Application

Set objApp = CreateObject("Outlook.Application")

On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select

Set objApp = Nothing
End Function

Function DSMS_phone() 'get the phone number if this is a contact
Dim objItem As Object

Set objItem = GetCurrentItem()

If objItem.Class = olContact Then
With objItem
DSMS_phone = .MobileTelephoneNumber
' DSMS_email = .Email1Address 'not needed, just for fun
End With
End If

Set objItem = Nothing
End Function

Sub DSMS_button()
Dim explorer As explorer
Dim toolbars As CommandBars
Dim DesktopSMS As CommandBar
Dim SMSBtn As CommandBarButton

Set explorer = Outlook.ActiveExplorer
Set toolbars = explorer.CommandBars
Set DesktopSMS = toolbars.item("Desktop SMS")
Set SMSBtn = DesktopSMS.Controls.item("New S&MS")

SMSBtn.Execute

Set explorer = Nothing
Set toolbars = Nothing
Set DesktopSMS = Nothing
Set SMSBtn = Nothing
End Sub

Sub DSMS_form()
Call ClipBoard_SetData(DSMS_phone)
DSMS_button
End Sub


for the clipboard handling, I am using this code below I found somewhere on
the web.
I did first use the example here
http://word.mvps.org/faqs/macrosvba/...eClipboard.htm
but it did not work reliably with the ClipMagic tool I am using. the version
below has not shown any problems so far.


Option Explicit

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

' Allocate movable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo ExitHere
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If

' Clear the Clipboard.
X = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

ExitHe

If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If

End Function