Is there a way, in Office 2003, to reference an Excel UDF in Outlook VBA (or
other applications)?

I created a function in an Excel workbook & I can use it in VBA in any other
Excel workbook by adding it via Tools/References/Browse . . . in VBE.

I want to use the same function in an Outlook VBA program but, if I try to
add a reference to the Excel workbook in Outlook VBE, it returns message,
"Can't add reference to the specified file."

Alternatively, is there somewhere else to create this function so that it
could be used in any Office application? From research, I believe an Add-in
would be ideal but I don't have Visual Studio & don't know what other options
are available.

I want to have it in a centralized location so that it is accessible to all
my users and can be easily maintained.

I tried someone's suggestion (thanks, JP) of using the Run method for the
function, VldLogin(), in Outlook using the following code:

On Error Resume Next
Set XL = GetObject(, "Excel.Application")
If XL Is Nothing Then
Set XL = CreateObject("Excel.Application")
End If
Set CmnWB = XL.Workbooks("CmnPrc.xls")
If CmnWB Is Nothing Then
XL.Workbooks.Open FileName:= _
"\\server\Path\CmnPrc.xls"
End If

LoginVld = XL.Run("VldLogin()")

If Not LoginVld = True Then
Set XL = Nothing
Exit Sub
End If

Stepping thru the code, when it hits 'LoginVld = XL.Run("VldLogin()")', it
accesses the function & shows the Userform.
The form seems to work correctly. If I omit an entry or enter invalid data,
I get the correct messages.
However, if I enter valid data, it never returns to the Outlook module.
Instead, the UserForm shows again & I seem to be caught in a loop there.

Using the function in Excel VBA, I don't have this problem. It works
perfectly.

Here is the function, along with 3 Public variables, 2 of which I use after
returning from the function:

Public Abt
Public UsrID
Public Psw

Function VldLogin() As Boolean
Abt = vbNo
Load QryLogin
QryLogin.Show
If Abt = vbYes Then
VldLogin = False
Else
VldLogin = True
End If
End Function

The userform has the following code:

Private Sub Cancel_Click()
Login.Abt = MsgBox("Are You Sure You Want To Cancel?", vbYesNo +
vbDefaultButton2)

If Login.Abt = vbYes Then
Unload Me
Else
Me.UsrID.SetFocus
End If
End Sub

Private Sub OK_Click()

Dim LoginAut As Boolean

If Len(Trim(Me.UsrID)) = 0 Then
MsgBox ("You Must Enter A User Name")
Me.UsrID.SetFocus
ElseIf Len(Trim(Me.Psw)) = 0 Then
MsgBox ("You Must Enter A Password")
Me.Psw.SetFocus
Else
LoginAut = AutLogin(Me.UsrID, Me.Psw)

If LoginAut = True Then
Login.UsrID = Me.UsrID.Value
Login.Psw = Me.Psw.Value
Unload Me
Else
MsgBox ("Invalid Username or Password; Please Re-Enter")
Me.UsrID.SetFocus
End If
End If
End Sub

Function AutLogin(ByVal UsrID As String, _
ByVal Psw As String) _
As Boolean

Const ADS_SECURE_AUTHENTICATION = 1
Dim Aut As Object ' Authentication
Dim Dmn As String ' Domain
Dim G_C As Object ' Global Catalog
Dim Root As Object ' RootDSE

On Error Resume Next

Set Root = GetObject("GC://rootDSE")
Dmn = Root.Get("defaultNamingContext")
Set G_C = GetObject("GC:")
Set Aut = G_C.OpenDSObject("GC://" & Dmn, UsrID, Psw,
ADS_SECURE_AUTHENTICATION)

If Aut Is Nothing Then
AutLogin = False
Else
AutLogin = True
End If

Set Aut = Nothing
Set G_C = Nothing
Set Root = Nothing

End Function


--
Will

Unfortunately VBA Class objects cannot be "public created", which would be
the normal way to access functions from another Com app. If you have say
..Net or VB6 (my preferred) to hand that would be the way to go.

However, here's a sneaky way to call functions from an Excel workbook
without using App'.run or a CallBack. This is based on the idea that
although ordinary class modules cannot be created externally, a Sheet module
is a class module that is already created and public.

' In an Excel Worksheet module, say Sheet1
Public Function hello(arg) As String
hello = arg & vbCr & "hello from " & Me.Name
End Function

Save the file

To ensure you get the fullpath & name correctly, in the debug window do
?thisworkbook.fullname

'In Some other VBA app, eg Word or Outlook
Private objWB As Object
Private Const cWBfile As String = "C:\<path\myBook.xls"

Sub test()
Dim bFlag As Boolean
Dim vResult
Dim sWBfile As String

If GetWB Then
vResult = objWB.Worksheets("Sheet1").hello("greetings from Word")
End If

MsgBox vResult
End Sub
Function GetWB() As Boolean
Dim bFlag As Boolean

If Not objWB Is Nothing Then
If Len(objWB.Name) = 0 Then
Else: bFlag = True
End If
End If

If bFlag = False Then
' might get a macro warning here if the file is not open
Set objWB = GetObject(cWBfile)
bFlag = Not objWB Is Nothing
End If

GetWB = bFlag
End Function

Sub CleanUp() ' ****** don't forget to call this
' be sure to do this when done, eg in the close event
Set objWB = Nothing
End Sub

Personally I've never used this approach, actually I've only just thought of
it!

Regards,
Peter T


"wpiet" wrote in message
...
Is there a way, in Office 2003, to reference an Excel UDF in Outlook VBA
(or
other applications)?

I created a function in an Excel workbook & I can use it in VBA in any
other
Excel workbook by adding it via Tools/References/Browse . . . in VBE.

I want to use the same function in an Outlook VBA program but, if I try to
add a reference to the Excel workbook in Outlook VBE, it returns message,
"Can't add reference to the specified file."

Alternatively, is there somewhere else to create this function so that it
could be used in any Office application? From research, I believe an
Add-in
would be ideal but I don't have Visual Studio & don't know what other
options
are available.

I want to have it in a centralized location so that it is accessible to
all
my users and can be easily maintained.

I tried someone's suggestion (thanks, JP) of using the Run method for the
function, VldLogin(), in Outlook using the following code:

On Error Resume Next
Set XL = GetObject(, "Excel.Application")
If XL Is Nothing Then
Set XL = CreateObject("Excel.Application")
End If
Set CmnWB = XL.Workbooks("CmnPrc.xls")
If CmnWB Is Nothing Then
XL.Workbooks.Open FileName:= _
"\\server\Path\CmnPrc.xls"
End If

LoginVld = XL.Run("VldLogin()")

If Not LoginVld = True Then
Set XL = Nothing
Exit Sub
End If

Stepping thru the code, when it hits 'LoginVld = XL.Run("VldLogin()")', it
accesses the function & shows the Userform.
The form seems to work correctly. If I omit an entry or enter invalid
data,
I get the correct messages.
However, if I enter valid data, it never returns to the Outlook module.
Instead, the UserForm shows again & I seem to be caught in a loop there.

Using the function in Excel VBA, I don't have this problem. It works
perfectly.

Here is the function, along with 3 Public variables, 2 of which I use
after
returning from the function:

Public Abt
Public UsrID
Public Psw

Function VldLogin() As Boolean
Abt = vbNo
Load QryLogin
QryLogin.Show
If Abt = vbYes Then
VldLogin = False
Else
VldLogin = True
End If
End Function

The userform has the following code:

Private Sub Cancel_Click()
Login.Abt = MsgBox("Are You Sure You Want To Cancel?", vbYesNo +
vbDefaultButton2)

If Login.Abt = vbYes Then
Unload Me
Else
Me.UsrID.SetFocus
End If
End Sub

Private Sub OK_Click()

Dim LoginAut As Boolean

If Len(Trim(Me.UsrID)) = 0 Then
MsgBox ("You Must Enter A User Name")
Me.UsrID.SetFocus
ElseIf Len(Trim(Me.Psw)) = 0 Then
MsgBox ("You Must Enter A Password")
Me.Psw.SetFocus
Else
LoginAut = AutLogin(Me.UsrID, Me.Psw)

If LoginAut = True Then
Login.UsrID = Me.UsrID.Value
Login.Psw = Me.Psw.Value
Unload Me
Else
MsgBox ("Invalid Username or Password; Please Re-Enter")
Me.UsrID.SetFocus
End If
End If
End Sub

Function AutLogin(ByVal UsrID As String, _
ByVal Psw As String) _
As Boolean

Const ADS_SECURE_AUTHENTICATION = 1
Dim Aut As Object ' Authentication
Dim Dmn As String ' Domain
Dim G_C As Object ' Global Catalog
Dim Root As Object ' RootDSE

On Error Resume Next

Set Root = GetObject("GC://rootDSE")
Dmn = Root.Get("defaultNamingContext")
Set G_C = GetObject("GC:")
Set Aut = G_C.OpenDSObject("GC://" & Dmn, UsrID, Psw,
ADS_SECURE_AUTHENTICATION)

If Aut Is Nothing Then
AutLogin = False
Else
AutLogin = True
End If

Set Aut = Nothing
Set G_C = Nothing
Set Root = Nothing

End Function


--
Will