I use task scheduler in windows to trigger macros, I wanted to do this with an Access database accdb file format, however I keep on getting an error
object required opencurrentdatabase("")
'Run Database
Dim ObjAccess, ObjDB
Set ObjAccess = CreateObject("Access.application")
objAccess.visible = false
Set ObjDB = ObjAccess.OpenCurrentDatabase("filepath\filename.accdb", False) 'error occurs here
ObjDB.Application.Run "'Checklist.accdb'!cmdChkSelectAll_Click"
ObjDB.Application.Run "'Checklist.accdb'!cmdGenerateAllLists_Click"
ObjDB.Close False
ObjAccess.Quit
Set ObjAccess = Nothing
The following works for me to run a VBA procedure in a general module and a macro:
Dim ObjAccess
Set ObjAccess = CreateObject("Access.application")
ObjAccess.visible = false
ObjAccess.OpenCurrentDatabase("filepath\filename.accdb")
ObjAccess.Run "Test6"
ObjAccess.DoCmd.RunMacro "Macro1"
ObjAccess.Quit
Set ObjAccess = Nothing
Related
I created a public function in an existing Access form and I`m trying to call it from outside the application.Very simple function just created for testing this.
Public Function test1(ByVal test1 As String)
Dim xlApp As New Excel.Application
xlApp.Visible = False
Dim wb As Excel.Workbook
Set wb = xlApp.Workbooks.Add
Dim ws As Excel.Worksheet
Set ws = wb.Worksheets(1)
End Function
I created the connection to it, on Automation Anywhere and I´m trying to call the function created.
Connection String im using:
Provider=Microsoft.ACE.OLEDB.16.0;Data Source="$connection$";Jet OLEDB:Database Password="$pass$"
Tried doing this, without suceed
Select test1("test")
EXEC test1("test1")
EXECUTE test1("test1")
Also with simple '
No way to do this on background so as suggested below I created a sub and called it from an VB Script
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase "RUTA ACCESS",,"CONTRASEÑA"
appAccess.UserControl = True
appAccess.Run "generarEtiqueta","numPropuesta","numExp","fileSavePath"
appAccess.CloseCurrentDatabase
appAccess.Quit
generarEtiqueta is the sub, all the other are arguments
You can create a module in access vba to use it in any form, or independent of form. The function can be called from outside as such:
Dim appAccess As New Access.Application
appAccess.OpenCurrentDatabase ("C:\My Documents\myDatabase.mdb")
appAccess.Run "myDatabase.test1", "Pass your argument here"
Running code behind a form requires the form to be open.
Example of a VBScript running a Sub and Function procedures in Access general module as well as a macro.
Dim ObjAccess
Set ObjAccess = CreateObject("Access.application")
ObjAccess.visible = false
ObjAccess.OpenCurrentDatabase("filepath\filename.accdb")
ObjAccess.Run("FunctionName") 'not finding a way to pass argument to Function
ObjAccess.Run "SubName", "argument" 'if Sub does not require argument then eliminate
ObjAccess.DoCmd.RunMacro "MacroName"
ObjAccess.Quit
Set ObjAccess = Nothing
I tested calling a Sub that issued a MsgBox and a Debug.Print. MsgBox works, Debug.Print does not.
I am exporting a recordset from an access query to an Excel Workbook. The export goes fine, and my syntax prompts the user for a filename/location just as I need. However, the file is not actually saved. Am I missing a step in the process or what code changes need to take place in order to have this function?
Sub ETE()
Dim ExcelApp As Object, wbOutput As Object, wsOutput As Object, bExcelOpened As Boolean
Dim db As DAO.Database, rs As DAO.Recordset, targetRow As Long
Dim targetPath As String, fd As FileDialog, Title As String, saveInfo As Variant
DoCmd.Hourglass True
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
On Error GoTo Error_Handler
Set ExcelApp = CreateObject("Excel.Application")
bExcelOpened = False
Else
bExcelOpened = True
End If
On Error GoTo Error_Handler
ExcelApp.ScreenUpdating = False
ExcelApp.Visible = False
Set wbOutput = ExcelApp.Workbooks.Add()
Set wsOutput = wbOutput.Sheets(1)
Set db = CurrentDb
Set rs = db.OpenRecordset("qryTakeDataToExcel", dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
'Write the data to Excel
End If
End With
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.AllowMultiSelect = False
.Title = "Select Save Location And File Name"
.InitialFileName = "File_" & Format(Now(), "mmddyyyy") & ".xlsx"
If .Show = True Then
wbOutput.SaveAs FileName:=fd.InitialFileName, FileFormat:=50
wbOutput.Close
End If
End With
End Sub
Your filedialog code is not working as expected, and because of that, you're not getting a valid file name and location.
If you want to return the file name picked, you should use .SelectedItems(1), not .InitialFileName. .InitialFileName sets an initial value and doesn't return the full path.
If .Show = True Then
wbOutput.SaveAs FileName:=.SelectedItems(1), FileFormat:=50
wbOutput.Close
End If
This would've probably been easier to catch if you'd have used a valid error handler. Use On Error GoTo 0 to use the default error handler.
I am running a few modules of code in access and am writing data into
Excel. When I write the first time, data gets written properly. But again
when I try, the new data is written on top of the old data. What should I do to
insert a new sheet?
My existing code is
Dim objexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim wbExists As Boolean
Dim objSht As Excel.Worksheet
Dim objRange As Excel.Range
Set objexcel = CreateObject("excel.Application")
On Error GoTo Openwb
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\REPORT1.xls")
Set objSht = wbexcel.Worksheets("Sheet1")
objSht.Activate
wbExists = True
Openwb:
On Error GoTo 0
If Not wbExists Then
objexcel.Workbooks.Add
Set wbexcel = objexcel.ActiveWorkbook
Set objSht = wbexcel.Worksheets("Sheet1")
End If
I think that the following code should do what you want. It's very similar to yours, except it uses the return values from the .Add methods to get the objects you want.
Public Sub YourSub()
Dim objexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim wbExists As Boolean
Set objexcel = CreateObject("excel.Application")
'This is a bad way of handling errors. We should'
'instead check for the file existing, having correct'
'permissions, and so on, and actually stop the process'
'if an unexpected error occurs.'
On Error GoTo Openwb
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\REPORT1.xls")
wbExists = True
Openwb:
On Error GoTo 0
If Not wbExists Then
Set wbexcel = objexcel.Workbooks.Add()
End If
CopyToWorkbook wbexcel
EndSub
Private Sub CopyToWorkbook(objWorkbook As Excel.Workbook)
Dim newWorksheet As Excel.Worksheet
set newWorksheet = objWorkbook.Worksheets.Add()
'Copy stuff to the worksheet here'
End Sub
I am trying to call a function when running a sub proecudere, however, I keep getting an error message saying "Argument not optional", can someone help?
Code as follows:
Public Sub ret()
Dim FSO As New Scripting.FileSystemObject
Const cstrFolderF = "\\tblSCFLAGCHECKER.txt"
If FSO.FileExists(cstrFolderF) Then
DoCmd.RunSQL "DELETE * FROM [tblSCFLAG_CHECKER]"
DoCmd.TransferText acImportDelim, "tblSCFLAG_CHECKER", "tblSCFLAG_CHECKER", cstrFolderF, True
changefieldnames
Else
'SCAnswer = MsgBox("SC Flags does not exist, do you wish to continue?", vbYesNo Or vbQuestion Or vbDefaultButton2)
'If SCAnswer = vbNo Then Exit Sub
End If
End Sub
Private Sub changefieldnames()
Dim db As Database
Dim tdf As TableDef
Dim n As Object
Set db = CurrentDb
Set tdf = db.TableDefs("tblSCFLAG_CHECKER")
For Each n In tdf.Fields
If n.Name = "?Person ID" Then n.Name = "Person ID"
Next n
Set tdf = Nothing
Set db = Nothing
End Sub
Your changefieldnames function requires two arguments but you give none in the call after
DoCmd.TransferText acImportDelim, "tblSCFLAG_CHECKER", "tblSCFLAG_CHECKER", cstrFolderF, True
changefieldnames
As a remark: you should try to debug your code instead of just posting an error without even stating where exactly the error occurs.
I've finished creating a database and it works perfectly on my computer. I'm using access 2013 and in my VBA code I have written error handler for each function/sub which I use in most databases.
However the users that it is designed for have Access run-time 2007 and every time i run it on their machine i get an un-trapped error "Execution of this application has stopped due to a run-time error".
Code for the command button.
Option Compare Database
Private Sub Command0_Click()
Dim ErrorStep As String
DoCmd.SetWarnings False
'-------------------------------------------------------------------------------------
' Procedure : Command0_Click
' Author : Chris Sparkes
' Date : 13/08/2013
'-------------------------------------------------------------------------------------
ErrorStep = "1 - Cleansing Records"
DoCmd.OpenQuery "qry1_3"
DoCmd.OpenQuery "qry4-7"
DoCmd.OpenQuery "qry9"
Call ExcelOutputReport
Exit_Command0_Click:
On Error GoTo 0
Exit Sub
Command0_Click_Error:
MsgBox "Error in procedure Command0_Click of VBA Document."
GoTo Exit_Command0_Click
On Error GoTo 0
End Sub
Public Function ExcelOutputReport()
Dim ErrorStep As String
DoCmd.SetWarnings False
'---------------------------------------------------------------------------------------
' Procedure : ExcelOutputReport
' Author : Chris Sparkes
' Date : 13/08/2013
'---------------------------------------------------------------------------------------
ErrorStep = "1 - Cleansing Records"
Dim dbLocal As DAO.Database
Dim tbloutput As DAO.Recordset
'DAO Declarations
Dim objExcel As New Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim IntCurrTask As Integer
Dim blurb As String
Set dbLocal = CurrentDb()
Set tbloutput = dbLocal.OpenRecordset("tbl_output")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("G:\Enliven Sales Report\Envliven_Report_Template_1.xls")
Set objWorksheet = objWorkbook.Worksheets("Enliven")
objExcel.Visible = True
objWorkbook.Windows(1).Visible = True
tbloutput.MoveFirst
IntCurrTask = 2
Do While Not tbloutput.EOF
With objWorksheet
.Cells(IntCurrTask, 1).Value = tbloutput![CustomerOrderCode]
.Cells(IntCurrTask, 2).Value = tbloutput![CustomerCode]
.Cells(IntCurrTask, 3).Value = tbloutput![CustomerDescription]
.Cells(IntCurrTask, 4).Value = tbloutput![ItemCode]
.Cells(IntCurrTask, 5).Value = tbloutput![ItemDescription]
.Cells(IntCurrTask, 6).Value = tbloutput![DateOrderPlaced]
.Cells(IntCurrTask, 7).Value = tbloutput![CustomerDueDate]
.Cells(IntCurrTask, 8).Value = tbloutput![Quantity]
.Cells(IntCurrTask, 9).Value = tbloutput![ShippedQuantity]
End With
IntCurrTask = IntCurrTask + 1
tbloutput.MoveNext
Loop
tbloutput.Close
dbLocal.Close
DoCmd.SetWarnings True
Set tbloutput = Nothing
Set dbLocal = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Exit_ExcelOutputReport:
On Error GoTo 0
Exit Function
ExcelOutputReport_Error:
MsgBox "Error at in procedure ExcelOutputReport of VBA Document."
GoTo Exit_ExcelOutputReport
End Function
Has anyone got any ideas what may be causing this? The references should be fine as I'm using the same ones that I know have worked with different databases that I've made.
Thanks,
Chris
You have added error routines, but you did not activate them. At the beginning of your methods, add an On Error Goto statement:
Private Sub Command0_Click()
On Error Goto Command0_Click_Error
...
End Sub
Public Function ExcelOutputReport()
On Error Goto ExcelOutputReport_Error
...
End Sub
In your error routines, you should display (at least) the contents of Err.Description instead of a generic error message. Otherwise, you will have a really hard time tracking the source of errors. E.g.:
MsgBox "Error in procedure Command0_Click: " & Err.Description