bedsingar
asked on
Access 2003 not recognising VBA script as a callback function
Hello,
I have written the following vba script, and following the advice from a previous question have setup a custom buton in an Access toolbar using the function_name() criteria in 'on action'. (I've used the name of the function) However when I click the custom button I get an error message saying "Can't run the macro or callback function - make sure it exists and takes the correct paramiters"
VBA code atatched.
Am I doing something wrong here?
Thanks
Josh
I have written the following vba script, and following the advice from a previous question have setup a custom buton in an Access toolbar using the function_name() criteria in 'on action'. (I've used the name of the function) However when I click the custom button I get an error message saying "Can't run the macro or callback function - make sure it exists and takes the correct paramiters"
VBA code atatched.
Am I doing something wrong here?
Thanks
Josh
Option Compare Database
Public emailaddress, ccaddress, Subject, body1 As String
Public baserow, toprow, countnumberofrows, emails As Integer
Public tempdir, projectlistdir, WBPATH As String
Option Explicit
' This module requires references to the
' following object libraries:
'
' 1. Microsoft Excel X.X Object Library,
' where X.X is the Excel Version Number.
'
' 2. One of the following:
'
' For mdb files:
' Microsoft DAO 3.6 Object Library
' (DAO360.DLL)
' For ACCDB files (Access 2007):
' Microsoft Office 12 Access Database Engine Objects
' (ACEDAO.DLL)
' This reference should be set already.
'
' To set the reference, in the VBA editor:
' Tools > References.
Public Function Export_BR_Data()
' Excel constants:
'Const strcXLPath As String = "C:\Josh\My Docs\Project List Data\OUTPUT\AG_ACCRUALS_TEMPLATE.xls"
' Const strcWorksheetName As String = "Sheet1"
Const strcCellAddress As String = "A2"
' Access constants:
Const strcQueryName As String = "QRY109_BRCHARGERPT_COLLATE_JOURNAL"
Const strcQueryName2 As String = "QRY100_BR_CHARGERPT_OVER_6WEEKS_OLD_AND_CLOSED"
Const strcQueryName3 As String = "QRY101_BR_CHARGERPT_FUTURE_TIMESHEETS"
Const strcQueryName4 As String = "QRY102_BR_CHARGERPT_OVER_50_HOURS"
Const strcQueryName5 As String = "QRY111_BRCHARGERPT_ACC_COST_CODE_ERRORS"
Const strcQueryName6 As String = "QRY110_BRCHARGERPT_ROLE_ERRORS"
' Excel Objects:
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range
' Excel Varaiables:
Dim RW, x As Integer
Dim AC As String
' DAO objects:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef
Dim objRS1 As DAO.Recordset
'SQL statements:
Dim SSQL As String
Dim intcolindex As Integer
'Get Sheet 1 Data______________________________________________________________________________
SSQL = "SELECT * FROM " & strcQueryName
' Open a DAO recordset 5 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
'Open a new XL file
Set objXL = New Excel.Application
objXL.Visible = True
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWBK = objXL.Workbooks.Add
Set objWS = objWBK.Worksheets("Sheet1")
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "Journal"
'close recordset
objRS1.Close '_________________________________________________________________________________
'Next Sheet
SSQL = "SELECT * FROM " & strcQueryName2
' Open a DAO recordset 5 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWS = objWBK.Worksheets("Sheet2")
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "OLD AND CLOSED"
'close recordset
objRS1.Close '_________________________________________________________________________________
'Next Sheet
SSQL = "SELECT * FROM " & strcQueryName3
' Open a DAO recordset 1 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWS = objWBK.Worksheets("Sheet3")
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "FUTURE TS"
'close recordset
objRS1.Close '_________________________________________________________________________________
'Next Sheet
SSQL = "SELECT * FROM " & strcQueryName4
' Open a DAO recordset 1 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWS = objWBK.Worksheets.Add
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "50 +"
'close recordset
objRS1.Close '_________________________________________________________________________________
'Next Sheet
SSQL = "SELECT * FROM " & strcQueryName5
' Open a DAO recordset 1 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWS = objWBK.Worksheets.Add
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "Cost Code Errors"
'close recordset
objRS1.Close '_________________________________________________________________________________
'Next Sheet
SSQL = "SELECT * FROM " & strcQueryName5
' Open a DAO recordset 1 on the query:
Set objRS1 = CurrentDb.OpenRecordset(SSQL)
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objWS = objWBK.Worksheets.Add
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS1
'put in column heads
AC = "A1"
For intcolindex = 0 To objRS1.Fields.Count - 1
objWS.Range(AC).Offset(0, intcolindex).Value = objRS1.Fields(intcolindex).Name
Next
'Format Sheet
objWS.Name = "JRSS Errors"
'close recordset
objRS1.Close '_________________________________________________________________________________
Exit_SaveRecordsetToExcelRange:
CleanUp:
' Destroy Excel objects:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing
' Destroy DAO objects:
' If Not objRS1 Is Nothing Then
' objRS1.Close
' Set objRS1 = Nothing
' End If
Set objQDF = Nothing
Set objDB = Nothing
GoTo Closeses
Error_Exit_SaveRecordsetToExcelRange:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"
GoSub CleanUp
Resume Exit_SaveRecordsetToExcelRange
MsgBox ("Job Complete")
Closeses:
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
You're a star :) (And I need to learn not to close threads so quickly!)
solution was in your second post & no () required.
Thanks
Josh
solution was in your second post & no () required.
Thanks
Josh
Glad to help out -
Just fyi, If you run into issues with a solution I've posted even after a question is closed, if I am around I am always happy to work through it with you if you just post a comment to the original thread.
Just fyi, If you run into issues with a solution I've posted even after a question is closed, if I am around I am always happy to work through it with you if you just post a comment to the original thread.
- Make sure you have checked the reference for Microsoft Excel
- Make sure you have checked the DAO reference
- Ensure that your function runs as expected without the toolbar button
- Double-check the spelling of your function name (I usually copy paste to make 100% certain when in doubt)
- I'm pretty sure you need the parentheses after the function name Export_BR_Data(), but try it both with and without
- I took a quick look over your function and didnt see any, but double-check that if there are any other functions/subs being called that they are also defined as Public.