Link to home
Start Free TrialLog in
Avatar of bedsingar
bedsingarFlag for United Kingdom of Great Britain and Northern Ireland

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
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

Open in new window

Avatar of mbizup
mbizup
Flag of Kazakhstan image

Try the following troubleshooting steps:

- 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.

ASKER CERTIFIED SOLUTION
Avatar of mbizup
mbizup
Flag of Kazakhstan image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of bedsingar

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
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.