Task Scheduler not working with MS Access

I had an MS Access app that was running a macro via Task Scheduler using the /x parameter. The macro was calling a public function, which is the only way you can call code from outside MS Access. The job would import a CSV file and it would work fine through the command prompt or via a batch file. BUT Task Scheduler would NOT run it. I would always get this issue!!

Microsoft Excel cannot access the file 'C:\Development\MSAccess\Import\ImportFile.csv'. There are several possible reasons:

• The file name or path does not exist. • The file is being used by another program. • The workbook you are trying to save has the same name as a currently open workbook.

So the solution for me was to download this: https://www.splinterware.com/products/scheduler.html

It's working now! If I have to pay for it at some point then $30 USD is well worth it for the days that I have spent trying to figure out why Task Scheduler won't run the job properly!

I posted this here too: Scheduled MS Access macro to run query and export to CSV - Stack Overflow

VBA Error 1004 when using Select on Excel Range.

Had a little error in my MS Access VBA when trying to use the Select method of an Excel Range. It turns out that you have to select the WorkSheet before the Range, otherwise you might get Error 1004

Sub RangeError()

    Dim xls As Excel.Application
    Dim xlsBook As Excel.Workbook
    Dim xlsSheet As Excel.Worksheet
    Dim xlsSheet2 As Excel.Worksheet

    Set xls = New Excel.Application
    Set xlsBook = xls.Workbooks.Open(PathToExcelFile)
    Set xlsSheet = xlsBook.Sheets("Sheet1")
    Set xlsSheet2 = xlsBook.Sheets("Sheet2")

    xlsSheet2.Select  'THIS LINE IS REQUIRED
    xlsSheet2.Range("C3").Select   'THIS IS THE PROBLEM LINE

End Sub

 

VBA Code hangs when Closing Workbook

I wrote some code to generate Excel Workbooks and Worksheets. All worked well on my Windows 10 development machine, but a when I ran it on the Server, running Windows 2019 Server, it hung on the Workbook.Close command, until I added the SaveChanges property like shown below.

This hung at the Close line.

Sub TestExcel()

    Dim obj As Object
    Dim wkb As Object

    Set obj = CreateObject("Excel.Application")
    Set wkb = obj.Workbooks.Open("C:\Users\[username]\Desktop\Excel\test.xlsx")

    ' Change True to False if you do not want to save
    wkb.Worksheets("Sheet1").Range("A1") = "Hello!"

    wkb.Close
    Set wkb = Nothing
    Set obj = Nothing

End Sub

 

This worked fine!

Sub TestExcel()

    Dim obj As Object
    Dim wkb As Object

    Set obj = CreateObject("Excel.Application")
    Set wkb = obj.Workbooks.Open("C:\Users\[username]\Desktop\Excel\test.xlsx")

    ' Change True to False if you do not want to save
    wkb.Worksheets("Sheet1").Range("A1") = "Hello!"

    DoEvents
    wkb.Close SaveChanges:=True
    Set wkb = Nothing
    Set obj = Nothing

End Sub

I retested with the SaveChanges option on Windows 10 and it worked fine. I added the DoEvents too, just to let the code catchup. But it was the SaveChanges that made the difference!

Happy Coding, Coder!

Resize Continuous Form

I recently needed to create a Modal Form that was a Continuous Form so that I could present the user with a selection of items. Initially, this was tall (full screen height) and very ugly so I needed to dynamically resize this form based on the number of Items that I needed to display. I also wanted to reposition the form so that it was in a place that looked right to the use. Keep in mind that I'm using Tabbed Forms and not Overlapping Forms style.

This is the simple code that I wrote! The qryTemp is just a table that I use for imported data. The GetUserName function just gets my username so I can just get my own data.

Private Sub Form_Load()
    ' 1 cm = 566.9291338583 twip, but using 580 for good measure!
    
    Dim intRows As Integer
    
    intRows = DCount("*", "qryTemp", "CreatedBy='" & GetUserName & "'")
    
    ' Add another row to prevent scrollbar from showing up
    intRows = intRows + 1
    Me.Form.InsideHeight = 2.6 * 580 + (340 * intRows)
    Me.Form.Move 580 * 10, 580 * 5
End Sub

Happy Coding, Coders!

 

Creating Excel Workbooks and Worksheets

I recently had the need to create workbooks and worksheets from scratch so this is what I did. No error trapping was added in order to keep the example simple!

Public Sub CreateExcelWorkBookAndSheetsTest()

    Dim xlsNew As Excel.Application
    Dim wkbNew As Excel.Workbook
    Dim wksNew As Excel.Worksheet
    Dim strNewWorkBook As String
    Dim strWorkBookName As String
    
    ' Create the New Workbook Name
    strWorkBookName = "TEST EXCEL FROM MSACCESS VBA"
    strNewWorkBook = CurrentProject.Path & "\" & strWorkBookName & ".xlsx"
        
    If Dir(strNewWorkBook) <> "" Then
        Kill strNewWorkBook
    End If
    
    ' Create a New Excel File and add the WorkSheet to it. Then add the WorkSheet.
    Set xlsNew = New Excel.Application
    
    ' New Workbook
    Set wkbNew = xlsNew.Workbooks.Add
    
    ' Create Workbook and name the first Worksheet Index. By default it will be Sheet1
    ' Reference Worksheets(1) because this is the first worksheet that is created with the initial workbook!
    Set wksNew = wkbNew.Worksheets(1)
    wksNew.Name = "Index"
    ' Use SaveAs only once at the beginning!
    wkbNew.SaveAs strNewWorkBook, xlOpenXMLWorkbook
    
    ' Add another Worksheet and name it Main Data 1. Create a new reference to the worksheet using Count!
    Set wksNew = wkbNew.Worksheets(wkbNew.Sheets.Count)
    ' Add the worksheet to the workbook "After" the wksNew reference that we created above.
    wkbNew.Sheets.Add After:=wksNew
    wkbNew.Sheets(wkbNew.Sheets.Count).Name = "Main Data 1"
    ' Just need to use Save now as we have already saved it once.
    wkbNew.Save
    
    ' Add another Worksheet and name it Main Data 2. Same comments as above.
    ' You can use After:= to reference the [After] parameter or you can just used the parameter like below.
    Set wksNew = wkbNew.Worksheets(wkbNew.Sheets.Count)
    wkbNew.Sheets.Add , wksNew
    wkbNew.Sheets(wkbNew.Sheets.Count).Name = "Main Data 2"
    ' Just need to use Save now as we have already saved it once.
    wkbNew.Save
    
    ' Add a Final Worksheet call Total
    Set wksNew = wkbNew.Worksheets(wkbNew.Sheets.Count)
    wkbNew.Sheets.Add , wksNew
    wkbNew.Sheets(wkbNew.Sheets.Count).Name = "Total"
    ' Just need to use Save now as we have already saved it once.
    wkbNew.Save

    ' Now you can create another worksheet and put it before or after another one!
    Set wksNew = wkbNew.Worksheets(wkbNew.Sheets.Count)
    wkbNew.Sheets.Add Before:=wksNew
    ' We use the -1 in this case as we want to make sure we Name the sheet before the reference "Before" using wksNew
    wkbNew.Sheets(wkbNew.Sheets.Count - 1).Name = "Final Test"
    ' Just need to use Save now as we have already saved it once.
    wkbNew.Save

    ' Now we just add 5 new sheets! These are added starting at the beginning of the last Sheet (workbook) we added, Final Test
    wkbNew.Sheets.Add Count:=5

    Set xlsNew = Nothing

    Application.FollowHyperlink strNewWorkBook
End Sub

 

MS Access Error 3283 Primary key already exists

Source: FIXED: Error 3283 Refresh Links (isladogs.co.uk) - and - RefreshLink fails with "Primary Key already exists" (accessforever.org) -  Thanks!

I came across error 3283 - Primary key already exists after the MS Office system had been updated to version 2312 Build 16.0.17126.20190 for Monthly Enterprise  Channel.

The error happens when calling RefreshLink as shown in the code sample below. Disclaimer: This worked for me, but your solution might be different. The solution "for now" is to use On Error Resume Next and deal with the error afterwards as the table does in fact relink just fine. Microsoft say that a fix will not be released until March 12th 2024 in version 2401. So you will need to implement this work around until it's resolved.

For Each tblDef In tblDefs
	If tblDef.Connect <> "" Then
		If InStr(1, tblDef.Connect, "ODBC") > 0 Then
			'SQL Server Database
			If (tblDef.Connect <> strSQLConnectionString) Or blnForceReconnect Then
				tblDef.Connect = strSQLConnectionString
								   
				' Error 3283 when refreshing links using code caused by MS Office Update 2312 Build 16.0.1716.20190
				' A fix will be applied by Microsoft on March 12th 2024 Office Updates for build 2401.
				On Error Resume Next
				tblDef.RefreshLink
			
				' This is required if the SQL View is to be update-able
				If tblDef.Name = "vw_Example" Then
					CurrentDb.Execute "CREATE UNIQUE INDEX __uniqueindex ON " & tblDef.Name & " (ID ASC)"
				End If
														
				Err.Clear
				On Error GoTo ErrorHandler
				
			End If
		End If
		
	End If
Next tblDef

Thanks to Isladogs on Access and Access Forever for this post.

MS Access Dynamic Report Sorting

I came across a request from a client who wanted the sorting from a Form to be transferred to a Report. Meaning that whatever was sorted for the Data Sheet view in a sub-form, to be transferred to the Report. This was a task that became almost impossible until I discovered a few things.

  1. You cannot sort a Report Query and expect it to sort in a Report. It will not work.
  2. You have to pass in the Forms Order By property, or update a global variable to store the sorting.
  3. There is manual VB work involved.
  4. There is also dummy Groups that are needed in the report that have to be updated when the Report is opened.

This is how I did it. I created a global variable to hold the Order By string from the Sub form. This variable was in a module, any module

Public g_strJobCostSort As String

I then wrote this code for opening the Report. Note that I had to remove certain sections of the Order String because of control names like Lookup_cboVendor, which is a dropdown in the sub-form.

    Dim strSQLSort As String
    
    If Nz(Me.subfrmJobCostItems.Form.OrderBy, "") <> "" Then
        strSQLSort = Replace(Replace(Me.subfrmJobCostItems.Form.OrderBy, "[qryJobCostItems].", ""), "[Lookup_cboVendor].[Company]", "[CompanyName]")
        g_strJobCostSort = strSQLSort
        DoEvents
    End If

    DoCmd.OpenReport "rptJobCostingCombined", acPreview, , "JobCostID=" & Me.txtJobCostID

I also created 2 buttons on the Sub-Form so the user could see the existing Sort Order and also clear it. One thing worth noting too is that the last column you sort on is actually the first column to be sorted on. It makes sense but you might need to try this is order for it to make any sense to you.

The Sorting button runs this code and the following dialog is shown.

MsgBox Replace(Replace(Me.subfrmJobCostItems.Form.OrderBy, "[qryJobCostItems].", ""), "[Lookup_cboVendor].[Company]", "[CompanyName]"), vbInformation, "Sorting"

The Clear Sorting code is this

    Me.subfrmJobCostItems.Form.OrderBy = ""
    Me.subfrmJobCostItems.Form.Requery

The Sub Report has the following Group On and Sort By properties/sections. I only added 4 Sort By sections but you can have as much as you like I guess. I noticed too that if I added a Group On but did not have a Group Header or Group Footer that it switched to a Sort by section. That's fine as it working the same way.

 This is the Code that I added to the Report_Open event in the subform. Note that I added " DESC" with a space at the beginning to make sure it was targeting the DESC sort order at the end, if there was one. If your columns have this combination, like Description, then you'll need to check that this code does not affect them. Basically this code gets all the sort columns, even if they're blank! This is why I chose to do On Error Resume Next. It's not the most glamorous way code, but it works and it will sort on the "up to" 4 sections that I added.

    Dim strSorting() As String
    strSorting = Split(g_strJobCostSort, ",")
    
    On Error Resume Next
    Me.GroupLevel(1).ControlSource = Replace(Replace(Replace(Replace(Trim(strSorting(0)), " DESC", ""), "]", ""), " ", ""), "[", "")
    Me.GroupLevel(2).ControlSource = Replace(Replace(Replace(Replace(Trim(strSorting(1)), " DESC", ""), "]", ""), " ", ""), "[", "")
    Me.GroupLevel(3).ControlSource = Replace(Replace(Replace(Replace(Trim(strSorting(2)), " DESC", ""), "]", ""), " ", ""), "[", "")
    Me.GroupLevel(4).ControlSource = Replace(Replace(Replace(Replace(Trim(strSorting(3)), " DESC", ""), "]", ""), " ", ""), "[", "")
    DoEvents
    
    If InStr(strSorting(0), "DESC") > 0 Then
        Me.GroupLevel(1).SortOrder = True
    End If
    
    If InStr(strSorting(1), "DESC") > 0 Then
        Me.GroupLevel(2).SortOrder = True
    End If
    
    If InStr(strSorting(2), "DESC") > 0 Then
        Me.GroupLevel(3).SortOrder = True
    End If
    
    If InStr(strSorting(3), "DESC") > 0 Then
        Me.GroupLevel(4).SortOrder = True
    End If

Just as a courtesy, I have add the following links that helped me get to this solution after about 8 hours of trying. 

https://stackoverflow.com/questions/18836199/access-2010-vba-to-sort-a-report-with-existing-grouping/51014170#51014170?newreg=168265e41fd044cea63b1817e09e86ea

https://stackoverflow.com/questions/40402/what-is-the-command-to-truncate-a-sql-server-log-file

https://accessexperts.com/blog/2011/07/15/dynamically-sorting-forms-and-reports/

http://allenbrowne.com/ser-33.html - Allen Browne from Perth, Australia, is a legend!

Happy Coding, Coders!

 

Get the Full Build and Version of MS Access in VBA

To get the Full "Build" of MS Access in VBA use the following in a function.

CreateObject(“Scripting.FileSystemObject”).GetFileVersion(SysCmd(acSysCmdAccessDir) & “\msaccess.exe”)

To Get the "Version" you have to look it up here from the Build Number: https://learn.microsoft.com/en-us/officeupdates/update-history-microsoft365-apps-by-date. There is currently no way to look this up in VBA. You'll need to use some HTML screen scraping to get this number from this URL.

To get the Bit you'll need to use a function like this.

Public Function IsOfficex64() As Boolean
    ' Test whether you are using the 64-bit version of Office.
    #If Win64 Then
       IsOfficex64 = True
    #Else
       IsOfficex64 = False
    #End If
End Function