I've been playing with this problem for some time, and havent figured out how to do it.
I have the same function in every worksheet (and those sheets are named like this Name="One", CodeName="SheetOne" ...):
const someVar as Boolean = True
Public Function myFunction() as Boolean
myFunction = someVar
End Function
Now I want it to be called from outside like this - In ThisWorkbook there is procedure "doThis()" and function "TestThis():
Sub doThis()
Dim i as Integer
For i = 1 to ThisWorkbook.Sheets.Count
If testThis(ThisWorkbook.Worksheets(i)) = True then
Debug.print "Success!"
End If
Next i
Function testThis(x As Worksheet)
If x.myFunction = True Then
testThis = True
Else
testThis = False
End If
Now I know that at this line "If x.myFunction = True" it throws error "Method or data member not found", because i cant call that function with this reference, so I've tried it with VBComponent:
Sub doThis()
Dim i as Integer
For i = 1 to ThisWorkbook.Sheets.Count
If testThis(ThisWorkbook.VBProject.VBComponents(Worksheets(i).CodeName)) _
= True then
Debug.print "Success!"
End If
Next i
Function testThis(x As VBComponent)
If x.myFunction = True Then
testThis = True
Else
testThis = False
End If
But again, it throws an "Object does not support this property or method" error. Any ideas, How can I call that function from a variable, that has stored reference of any kind to that Worksheet? Any help would be appreciated.
When compiling the code, Excel checks to see if "WorkSheet" object type has a myFunction method - it is looking at the generic built-in Worksheet object, and this doesn't include your "add on" function (and neither does the "VBComponent" type), so it throws an error.
If you change your parameter type to Object (a more generic type) then it will compile...
Function testThis(x As Object)
testThis = x.myFunction()
End Function
I know this is an old thread but I thought I may as well share my discoveries.
Also, I suspect there is a better way to evaluate the exact same function in every sheet but, for anyone searching, here is a solution to do exactly what you asked for in the title of the post.
In your ThisWorkbook include
Const myFunction = "myFunctuion"
Public ws as Worksheet
For each ws in Me.Sheets
If testThis(ws) then Debug.print "Success!"
next ws
Function testThis(x as Worksheet)
testThis = callByName x, x.CodeName & "." & myFunction
End Function
Related
So I'm working on a VBA function in Access 2010 that creates a Word.Application object and returns it. Later on I want to be able to close this object, however not if its a Word.Application object that was not started by my program.
Public myGlobalWordApp as Object
Public newWordAppInstCreated as Boolean
Function GetWordAppInstance(Optional isVisible As Boolean = False) As Object
newWordAppInstCreated = False
On Error Resume Next
Set myGlobalWordApp = GetObject(, "Word.Application")
If myGlobalWordApp = Nothing Then
myGlobalWordApp = CreateObject("Word.Application")
myGlobalWordApp.Visible = isVisible
newWordAppInstCreated = True
End If
Set GetWordAppInstance = myGlobalWordApp
End Function
I want to make a CloseWordAppInstance() Sub that closes the myGlobalWordApp application object BUT ONLY if my VBA code was the one to open it. Sometimes I'll have another Word document up that I'm looking at and I don't want that window to be closed.
I've looked at the Word 2010 Application documentation and I saw that there is a .Parent method that I can call. I imagine that I could use this to see if I can determine if my Access Document/Module/Application created the Word.Application object but I dont know how to reference the "current object" or know how to do the comparison. Any help on that step would be appreciated.
My only "impropper" way of doing this would be checking the Boolean flags that I attempted to make, but that wont work if I make a second object.
Alternatively if anyone knows a better way to do this process that would be great!
You need to make sure that after you have created a word instance, you keep its reference. You can then use the same reference to close the word instance.
Private myGlobalWordApp As Object
Public Function GetWordAppInstance(Optional isVisible As Boolean = False) As Object
On Error GoTo ErrH
If myGlobalWordApp Is Nothing Then
'' create a new word instance if one doesn't exist
Set myGlobalWordApp = CreateObject("Word.Application")
myGlobalWordApp.Visible = isVisible
Set GetWordAppInstance = myGlobalWordApp
Else
'' otherwise return the instance we have
Set GetWordAppInstance = myGlobalWordApp
End If
Exit Function
ErrH:
MsgBox "Error creating word instance!", vbExclamation
End Function
Public Sub CloseWordInstance()
If Not myGlobalWordApp Is Nothing Then
'' close our word instance
myGlobalWordApp.Quit False
Set myGlobalWordApp = Nothing
End If
End Sub
You should never need to use the myGlobalWordApp variable directly. You can instead call the GetWordAppInstance to get the word instance and the CloseWordInstance to safely close it. This would ensure that you don't ever overwrite the myGlobalWordApp variable and lose reference to the word instance.
Public Sub Test()
Dim myWordInst As Object, wdDoc As Object
Set myWordInst = GetWordAppInstance(True)
Set wdDoc = myWordInst.Documents.Add
' do something with this doc here
CloseWordInstance
End Sub
I came upon this (modified) function in a Stack Overflow page and have been trying to get it to work without giving up on the passed object (if I handle the Access.Application strictly within the first routine it will work).
Yes I know of a number of ways to get the same answer (mostly from other posts on the stack), but there is a general concept here of passing objects to functions that I would like to master--please forget for a moment that the function checks the existence of a table.
Function FCN_CheckTblsExist(theDatabase As Access.Application, _
tableName As String) As Boolean
'access.Application.CurrentData.AllTables.Count
'etc is the 'workaround enabling disposal of
'the "theDatabase" object variable
' Presume that table does not exist.
FCN_CheckTblsExist = False
' Define iterator to query the object model.
Dim iTable As Integer
' Loop through object catalogue and compare with search term.
For iTable = 0 To theDatabase.CurrentData.AllTables.Count - 1
If theDatabase.CurrentData.AllTables(iTable).Name = tableName Then
FCN_CheckTblsExist = True
Exit Function
End If
Next iTable
End Function
Function callFCN_CheckTblsExist(tableName As String)
'this is an example of a curried function?--step down in dimensionality
Dim bo0 As String
Dim A As Object
Set A = CreateObject("Access.Application")
bo0 = FCN_CheckTblsExist(A, tableName)
MsgBox tableName & " Exists is " & bo0
End Function
I don't know if the (theDatabase As Access.Application, . ) part is correct, that may be the root of the problem, rather than the Dim, Set, Object (New?) gymnastics that may be required in the auxiliary procedure. Maybe there is a reference library problem (I'm running Access 2013).
Update: I am not sure the following is robust enough but this is what I meant earlier in the post, which is just being put here for completeness. BTW, this is not a split application so maybe that is why the following works. I appreciate HansUp's post, Not enough can be said on this subject. Anyway
Public Function FCN_CheckTblsExist(tableName As String) As Boolean 'Call this function once for every table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim appAccess As New Access.Application
Dim theDatabase As Access.Application
' Presume that table does not exist.
FCN_CheckTblsExist = False
' Define iterator to query the object model.
Dim iTable As Integer
For iTable = 0 To Access.Application.CurrentData.AllTables.Count - 1
If Access.Application.CurrentData.AllTables(iTable).Name = tableName Then
FCN_CheckTblsExist = True
Exit Function
End If
Next iTable
End Function
Just wanted to add that this last function I posted technically would be considered to be partial or no currying depending on how much the scope of the function was limited by invoking "Access.Application.CurrentData.AllTables." as a substitute for "theDatabase", only substituting the specific string created by Access.Application.CurrentDb.Name into the original function ...(theDatabse,... would it be a true full currying.
Anyway passing objects to functions and the libraries and their methods are the primary focus of this discussion. When I get the DAO issue worked i should have a better feel for what may be going on and then I'll post and mark the best solution accordingly.
The problem is not really about passing an Access.Application object to your other function. Instead you create the Access.Application and later check for the existence of a table without having opened a database within that Access session. In that situation, theDatabase.CurrentData.AllTables.Count should trigger error
2467, "The expression you entered refers to an object that is closed or doesn't exist."
I revised both procedures and tested them in Access 2010. Both compile and run without errors and produce the result I think you want.
Function FCN_CheckTblsExist(theDatabase As Access.Application, _
tableName As String) As Boolean
Dim tdf As DAO.TableDef
Dim blnReturn As Boolean
blnReturn = False
For Each tdf In theDatabase.CurrentDb.TableDefs
If tdf.Name = tableName Then
blnReturn = True
Exit For
End If
Next ' tdf
FCN_CheckTblsExist = blnReturn
End Function
Function callFCN_CheckTblsExist(DbPath As String, tableName As String)
Dim bo0 As Boolean
Dim A As Object
Set A = CreateObject("Access.Application")
A.OpenCurrentDatabase DbPath
bo0 = FCN_CheckTblsExist(A, tableName)
MsgBox tableName & " Exists is " & bo0
Debug.Print tableName & " Exists is " & bo0
A.Quit
Set A = Nothing
End Function
Note I didn't include any provision to check whether the DbPath database exists before attempting to open it. So you will get an error if you give it a path for a database which does not exist.
DAO Reference Issues:
DAO 3.6 was the last of the older DAO series. It only supports the older MDB type databases. When Access 2007 introduced the ACCDB database type, a new DAO library (Access database engine Object Library, sometimes referred to as ACEDAO) was introduced. In addition to supporting ACCDB databases, ACEDAO can also support the older MDB types.
When setting references, don't attempt to choose both.
Here is a screenshot of my project references:
When I examine my project references in the Immediate window, notice that ACEDAO is even referred to as just DAO. I also ran the callFCN_CheckTblsExist procedure to demonstrate it works without a DAO 3.6 reference:
That was all based on Access 2010. You're using Access 2013, so your ACEDAO version number may be different, but everything else should be the same.
Here are a couple of solutions along with a much simpler way to check if a table exists:
Workspace/Database; (much faster than using Application)
Function TestFunction_DataBase()
Dim ws As Workspace
Dim db As Database
Set ws = CreateWorkspace("", "admin", "", "dbUseJet")
Set db = ws.OpenDatabase("the db path", , , CurrentProject.Connection)
MsgBox TdefExists_DataBase(db, "the table name")
db.Close
ws.Close
Set db = Nothing
Set ws = Nothing
End Function
Function TdefExists_DataBase(ac As Database, strTableName As String) As Boolean
'check to see if table exists
On Error GoTo ErrHandler
Dim strBS As String
strBS = ac.TableDefs(strTableName).Name
TdefExists_DataBase = True
Exit Function
ErrHandler:
TdefExists_DataBase = False
End Function
Application:
Function TestFunction_Application()
Dim ac As New Access.Application
ac.OpenCurrentDatabase "the db path"
MsgBox TdefExists_Application(ac, "the table name")
ac.Quit
Set ac = Nothing
End Function
Function TdefExists_Application(ac As Access.Application, strTableName As String) As Boolean
'check to see if table exists
On Error GoTo ErrHandler
Dim strBS As String
strBS = ac.CurrentDb.TableDefs(strTableName).Name
TdefExists_Application = True
Exit Function
ErrHandler:
TdefExists_Application = False
End Function
Within the Current Database:
Function TdefExists(strName As String) As Boolean
'check to see if query exists
On Error GoTo ErrHandler
Dim strBS As String
strBS = CurrentDb.TableDefs(strName).Name
TdefExists = True
Exit Function
ErrHandler:
TdefExists = False
End Function
Private OutlookApp, Nms As Object
Sub TestSub()
Dim Fold As Object
Set OutlookApp = GetObject(, "Outlook.Application")
Set Nms = OutlookApp.GetNamespace("MAPI")
Set Fold = outlookFolderpath("Test Folder")
For Each Email In Fold.Items ' This loop doesnt work
Debug.Print Email.Subject
Next
End Sub
Private Function outlookFolderpath(Inbox As String) As Object
Dim fold_name As String
Set OutlookFolder_Path = Nms.Folders(Inbox).Folders("Inbox")
For Each Email In OutlookFolder_Path.Items ' This Loop works
Debug.Print Email.Subject
Next
End Function
Hello,
I was hoping someone could help me with the above code. I'm trying to Set and inbox folder path from a function and using it within the sub.
It works fine from within the function but not when setting it in the sub?
Can anyone see where I am going wrong? I get a runtime error '91' - Object variable or With block variable not set
so I would gather that the function is not returning the object but I'm not sure why?
thanks
You need to return the object from the function, so
Set OutlookFolder_Path = Nms.Folders(Inbox).Folders("Inbox")
should be
Set outlookFolderpath = Nms.Folders(Inbox).Folders("Inbox")
If you declare Option Explicit at the top of your code you will be less likely to run into problems like this as all your variable should be declared.
i'm trying to "compile" an Access ADP file to obtain an ADE with a small vbs script.
Option Explicit
Const acCmdMakeMDEFile = 603
Const msoAutomationSecurityLow = 1
Dim AccessADP
Set AccessADP = CreateObject("Access.Application")
AccessADP.AutomationSecurity = msoAutomationSecurityLow
AccessADP.visible=false
AccessADP.OpenCurrentDataBase(SourceOfADP)
I need to call one sub and one function which are written inside the ADP...for the sub no problem
AccessADP.Run "nameOfTheSub"
but i'm not able to use the function (that has to return one numeric value).
The Access function is very simple
public function getValue() as Integer
getValue=10
end function
none of these solutions works for me
dim returnValue
set returnValue = AccessADP.Run "getValue"
dim returnValue
returnValue = AccessADP.Run "getValue"
any ideas to catch the return value from the function from vbs?
thanks in advance
As you want to
get the return value of a function
expect a non-object return value
use
dim returnValue
returnValue = AccessADP.Run("getValue")
mark the param list () - see here - and the missing Set - see here.
How do I return a Worksheets Object Reference? I've been perusing through various Google searches with nada results.
For example, I have a functioning code like so. wSheet already dim'ed:
Public wSheet As Worksheet
...
Set wSheet = ActiveWorkbook.Worksheets("ExampleSheet")
wSheet.Range("A1").Value = "Hello"
However, I want wSheet to now call a module that supplies it to the correct reference. Something like this:
Public wSheet As Worksheet
...
Set wSheet = myModule.get_ExampleSheet
wSheet.Range("A1").Value = "Hello"
And then have a function in module myModule
Function get_ExampleSheet() As Worksheets
get_ExampleSheet = ActiveWorkbook.Worksheets("ExampleSheet")
End Function
Everything I try gives me various runtime errors. Is there anyway to get this to work?
Thanks and advance!
You are returning the wrong type of object in your function.
Function get_ExampleSheet() As Worksheets
get_ExampleSheet = ActiveWorkbook.Worksheets("ExampleSheet")
End Function
This currently has several errors.
Function get_ExampleSheet() As Worksheet
Set get_ExampleSheet = ActiveWorkbook.Sheets("Sheet1")
End Function
Note I changed:
Return type to Worksheet (you are trying to set a variable, wSheet, which is of type Worksheet to a Worksheets type variable)
Added set keyword
Changed to .Worksheets to .Sheets to return the specific sheet you are interested in
Sub Lookup()
Dim state As Variant
Dim PodName As Variant
Set state = ThisWorkbook.Worksheets("Sheet1").Range("E:E")
Sheets("Sheet1").Activate
PodName = WorksheetFunction.VLookup(state, Range("A1:C55"), 2, False)
ThisWorkbook.Worksheets("Sheet1").Range("F:F") = PodName
End Sub
Macro should stop once the target cell is blank
In order to return an Object from a function, you need to provide the Set keyword:
Function get_ExampleSheet() As Worksheet
Set get_ExampleSheet = ActiveWorkbook.Worksheets("ExampleSheet")
End Function
http://excelmacromastery.com/Blog/index.php/the-complete-guide-to-worksheets-in-excel-vba/
in your regular part of the code
Dim issues_sheet As Worksheet
Set issues_sheet = create_working_sheet("Issues")
issues_sheet.Range("A1").Value = "bssssbb"
the function can be something like
Function create_working_sheet(sheet_name As String) As Worksheet
For i = 1 To Worksheets.Count
If Worksheets(i).Name = sheet_name Then
exists = True
End If
Next i
If Not exists Then
Worksheets.Add.Name = sheet_name
'if we want it at the end
'Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
End If
Set create_working_sheet = ThisWorkbook.Sheets(sheet_name)
End Function
A complete overview of the ways you can set a worksheet using VBA can be found here: http://codevba.com/excel/set_worksheet.htm