Reference Excel UDF from Outlook
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
|