Solved

Setting references in a new Access database regardless of the version via VBA

Posted on 2014-01-23
21
364 Views
Last Modified: 2016-05-10
I have a MS Access Database that is used by several people.  I have written a lot of VBA code for this database.  The users have different versions of MS Access.  The problem is because there are users that have different versions of MS Access, they are getting errors because they have missing References for the version of MS Access that they are utilizing.

Is there a way to set the references via VBA each time the database opens based off of what version of MS Access the user has?

Thanks,

gdunn59
0
Comment
Question by:gdunn59
  • 7
  • 4
  • 2
  • +5
21 Comments
 
LVL 14

Expert Comment

by:Bill Ross
ID: 39804691
Hi,

If you create the DB and set references in the earliest version then all will work OK.  Most references are forward compatible but not backward.

Bill
0
 
LVL 142

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 39804695
not that I know of.
the only way to solve this would be to work fully without references.
hence, instead of set variable = new class_library.class_name you would need to do this instead: set variable = createobject("class_library.class_name")
all constants defined in those class_libraries would then not be available, and you should then create modules (eventually with the name being class_library) where you define those constants ...

or you move off to a non-access front-end
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39804766
I haven't set any references in the code, just manually through Tools/References.

Thanks,
gdunn59
0
Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

 
LVL 57
ID: 39804779
For the main base references, just go with the lowest version as Bill said.  References will automatically be updated for later versions.

For things other than the base references (VBA, Access, DAO and/or ADO), late bind everything for deployment.

Jim.
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39804784
Jim,

I've never done late binding.  Can you elaborate?

Thanks,
gdunn59
0
 
LVL 75
ID: 39804819
(no points)

Here are some good discussions on Early vs Late Binding

Using early binding and late binding in Automation
http://support.microsoft.com/kb/245115

Late Binding in Microsoft Access
http://www.granite.ab.ca/access/latebinding.htm

Late Binding ... for the most parts, eliminates the Reference issue associated with different versions of Access/Windows.  However, they could be - in some cases - a performance hit - since Access has to figure it out on the  fly. But with today's super fast systems, this is becoming less of an issue.

mx
0
 
LVL 142

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 39804823
late binding is what I wrote above (using CreateObject method)
0
 
LVL 57

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 500 total points
ID: 39804836
Example, for Excel:

1. You set a specific reference to a version of Excel in Tools/References.

2. In your code, you can do:

  Dim oExcel as Excel.Application

  Set oExcel = CreateObject("Excel.Application")


 This is early binding.  You've told the compiler via refernece extactly what library "Excel" is.

 In contrast, with late binding you:

1. Would not set a reference

2. In code, do:

 Dim oExcel as Object

 Set oExcel = CreateObject("Excel.Application")


 Notice the difference in the Dim.

  What it means to you:

Early binding:
1. You get intellisense in the VBA editor
2. It's 15% faster then late binding
3. Your tied to a specific type lib.  If your target machine doesn't have that specific lib, the code will fail.

Late binding:
1. You don't get intellisense
2. It's 15% slower then early binding
3. Your not tied to a specific lib/version.   If you send an e-mail using Outlook, your code will work with any version of Outlook (asssuming that the version supports the method/property that your using).

 Many early bind while developing (to get intellisense), then late bind for deployment.

Jim.
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39804856
mx:

So is this considered late binding?

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)


Thanks,
gdunn59
0
 
LVL 75
ID: 39804887
I will let Jim continue on ... :-)
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39804922
Jim,

This is what I have:

Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment


So mine is early binding, correct?
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39804940
Jim,

So I want to do late binding, correct?

As follows:

Dim objOutlook As object

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
0
 
LVL 57
ID: 39805013
Yes.  You are no longer tied to a specific version.  

Jim.
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39805058
Ok.  Thanks!
0
 
LVL 35

Expert Comment

by:PatHartman
ID: 39805079
Personally, I think MS should fix this once and for all.  It is not doing us any favors by refusing to downgrade references.

Rant over.

You can have the best of both worlds - early binding for development and late binding for fewer distribution issues by using conditional compilation and creating your own constants.

This is a sub from one of my apps that formats an Excel spreadsheet.  I don't have any Outlook examples handy so I'm posting this one so you can see how the conditional compilation works.  You control whether you want early or late by
#Const ExcelRef = 0

Private Sub FormatWeeklyJobStatus(sFileName)

Const xlDown = -4121
Const xlCellTypeLastCell = 11
Const xlThemeFontMinor = 2
Const xlPrintNoComments = -4142
Const xlPortrait = 1
Const xlPaperLegal = 5
Const xlPaperLetter = 1
Const xlOverThenDown = 2
Const xlPrintErrorsDisplayed = 0
 
    Dim sPath           As String
    Dim sTemplateName   As String
    Dim lngRows           As Long       'MUST be long
Dim ref As Reference

' 0 if Late Binding
' 1 if Reference to Excel set.
#Const ExcelRef = 0
#If ExcelRef = 0 Then ' Late binding
    Dim appExcel As Object     'Excel Object
    Dim wbkNew As Object    'Workbook Object
    Dim wksNew As Object    'Sheet Object
    Dim wbkTemplate As Object   'Workbook Object for Template

    Set appExcel = CreateObject("Excel.Application")
    ' Remove the Excel reference if it is present   -   <=======
    On Error Resume Next
    Set ref = References!Excel
    If Err.Number = 0 Then
        References.Remove ref
    ElseIf Err.Number <> 9 Then 'Subscript out of range meaning not reference not found
        MsgBox Err.Description
        Exit Sub
    End If
' Use your own error handling label here
On Error GoTo FormatWeeklyJobStatus_Error
#Else
    ' a reference to MS Excel <version number> Object Library must be specified
    Dim appExcel As Excel.Application      'Excel Object
    Dim wbkNew As Excel.Workbook        'Workbook Object
    Dim wksNew As Excel.Worksheet       'Sheet Object
    Dim wbkTemplate As Excel.Workbook   'Workbook Object for Template

    Set appExcel = New Excel.Application
#End If

    On Error GoTo FormatWeeklyJobStatus_Error

    sPath = DLookup("Database", "MsysObjects", "[Name] = 'tblJob'")
    sPath = Left(sPath, InStrRev(sPath, "\"))
    sTemplateName = sPath & "WeeklyJobStatusHeaders.xlsx"

    Set wbkNew = appExcel.Workbooks.Open(sFileName)
    Set wksNew = appExcel.Worksheets("qWeeklyJobStatusReportExcel")
    
    'remove column names - some bug is preventing HasFieldNames argument from working on the export
    If wksNew.Range("A1").Value = "ContractName" Then
        appExcel.Rows("1:1").Select
        appExcel.Rows("1:1").Delete
    End If
    
    ' Insert 5 rows at top to make room for headers
    With appExcel

        .Rows("1:1").Select
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        .Selection.Insert Shift:=xlDown
        
        ' Get headers from template file
        Set wbkTemplate = .Workbooks.Open(sTemplateName)
        wbkTemplate.Activate
        .Rows("1:5").Select
        .Selection.Copy
        
        ' Paste into new Workbook.
        wbkNew.Activate
        .ActiveSheet.Paste
        
        ' Close template
        .CutCopyMode = False    'clear clipboard to get rid of warning message
        wbkTemplate.Close
        
        'add job name
        .Range("A5").Value = Me.cboJob.Column(3)
        
        ' Count rows in new Workbook.
        .Selection.SpecialCells(xlCellTypeLastCell).Select
        lngRows = .Selection.Row
        
        'insert sum functions
            'the reference style below uses the current position so we subtract the number of rows (lngRows)
            'to get to the top and then add 5 to get past the headers
        .Cells(lngRows + 1, 4).Select     'column D - Total plan pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 5).Select     'column E - OFA pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 6).Select     'column F - BFA pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 7).Select     'column G - Issued to Shop pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 9).Select     'column I - Cut Issue pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 11).Select     'column K - Fitted pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 12).Select     'column L - Welded pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Cells(lngRows + 1, 13).Select     'column M - Shipped pieces
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & -lngRows + 5 & "]C:R[" & -1 & "]C)"
        
        .Range("A" & lngRows + 1 & ":N" & lngRows + 1).Select
        
        
        ' Freeze panes
        .Range("A6").Select
        .ActiveWindow.FreezePanes = True
        
        ' Header should print on every page when in Print Preview
        .ActiveSheet.PageSetup.PrintTitleRows = "$1:$5"
        .ActiveSheet.PageSetup.PrintTitleColumns = ""
        
       'format cells as numeric
        .Cells.NumberFormat = "#,##0_);[Red](#,##0)"
        
        ' Set format for date columns
        wksNew.Columns("H").NumberFormat = "d-mmm;@"
        wksNew.Columns("J").NumberFormat = "d-mmm;@"
            
        ' Set font and size
        .Cells.Select
        With .Selection.Font
            .Name = "Calibri"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
        
        ' Set page setup properties
        .Columns("A:N").Select
        .Selection.Columns.AutoFit
        
        With .ActiveSheet.PageSetup
            .PrintArea = "$A$1:$N$" & CStr(lngRows + 2)
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = appExcel.InchesToPoints(0.5)
            .RightMargin = appExcel.InchesToPoints(0.5)
            .TopMargin = appExcel.InchesToPoints(0.5)
            .BottomMargin = appExcel.InchesToPoints(0.5)
            .HeaderMargin = appExcel.InchesToPoints(0.5)
            .FooterMargin = appExcel.InchesToPoints(0.5)
            .PrintHeadings = False
            .PrintGridlines = True
            .PrintComments = xlPrintNoComments
           ' .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = IIf(lngRows > 44, xlPaperLegal, xlPaperLetter)
            .FirstPageNumber = xlAutomatic
            .Order = xlOverThenDown                         ' Change order to print all "page 1" before "page 2"
            .BlackAndWhite = False
            ''.Zoom = 80                                      ' Shrink down a little
            .Zoom = False                                   ' Should not need both
            .FitToPagesWide = 1
            .FitToPagesTall = False
            .PrintErrors = xlPrintErrorsDisplayed
        End With
    End With

    wbkNew.Save

FormatWeeklyJobStatus_Exit:
    On Error Resume Next
    ' Required for cleanup.
    wbkNew.Close
    Exit Sub

FormatWeeklyJobStatus_Error:
    Select Case Err.Number
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatWeeklyJobStatus of VBA Document Form_frmReports"
    End Select

    Resume FormatWeeklyJobStatus_Exit
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:Gozreh
ID: 39821192
Im using this code to add MS Reference
Public Sub CheckReference()
   Dim I As Integer, ProgLocation As String
   Dim RefName(3) As String
   RefName(0) = "MSWORD.OLB" 'Word Reference
   RefName(1) = "EXCEL.EXE" 'Excel Reference
   RefName(2) = "MSOUTL.OLB" 'Outlook Reference
   
   ProgLocation = SysCmd(acSysCmdAccessDir)
   For I = 0 To 2
      If Dir(ProgLocation & RefName(I)) <> "" And Not refExists(RefName(I)) Then
         Access.References.AddFromFile (ProgLocation & RefName(I))
      End If
      If Dir(ProgLocation & RefName(I)) = "" Then
         MsgBox ("ERROR: " & RefName(I) & " not found")
      End If
   Next
   
End Sub

Public Function refExists(Name As String) As Boolean
   Dim ref As Reference
   For Each ref In References
      If InStr(UCase(ref.FullPath), UCase(Name)) <> 0 Then
         refExists = True
      End If
   Next
End Function

Open in new window


But you will also need to remove them when database is closing, so that if next time it wll open with other version it should not be missing.
this is the code to remove MS Reference
Public Sub RemoveReference()
      refRemove "MSWORD.OLB"
      refRemove "EXCEL.EXE"
      refRemove "MSOUTL.OLB"
End Sub

Public Function refRemove(Name As String)
   Dim ref As Reference
   For Each ref In References
      If InStr(UCase(ref.FullPath), UCase(Name)) <> 0 Then
         References.Remove ref
      End If
   Next
End Function

Open in new window

0
 
LVL 1

Author Closing Comment

by:gdunn59
ID: 39821324
This seemed to work for me.  Thanks
0
 

Expert Comment

by:Keyboard Cowboy
ID: 41587551
What does the "#" in your vba code do?
0
 
LVL 35

Expert Comment

by:PatHartman
ID: 41587689
The pound sign in the VBA I posted indicates conditional compilation.  It is the only way you can make use of early binding for development and late binding for final distribution and easily (sort of) swap back and forth.  As far as I am concerned, there is no upside to late binding except that you are less likely to run into reference errors in a mixed environment.  If you don't have consistent Office versions, you have no viable alternative except developing in the lowest level environment.  That way when you distribute the app, it is bound to earlier versions of Office.  At runtime, Access will promote the references to newer versions if they exist on the local PC.

' 0 if Late Binding
' 1 if Reference to Excel set.
#Const ExcelRef = 0

When the constant is 0, late binding is used.  You MUST change the constant to 1 and recompile inorder to effect early binding.
0
 

Expert Comment

by:Keyboard Cowboy
ID: 41587705
Thanks
0
 
LVL 57
ID: 41587756
@Pat,

I don't see how this works:

' 0 if Late Binding
' 1 if Reference to Excel set.
#Const ExcelRef = 0
#If ExcelRef = 0 Then ' Late binding
    Dim appExcel As Object     'Excel Object
    Dim wbkNew As Object    'Workbook Object
    Dim wksNew As Object    'Sheet Object
    Dim wbkTemplate As Object   'Workbook Object for Template

    Set appExcel = CreateObject("Excel.Application")
    ' Remove the Excel reference if it is present   -   <=======

 If you distribute without the reference set and late binding, no problem.  But if you set the reference, even though you may remove it, it's already been loaded once you hit the first ambiguous statement, at which point the reference can break.  So I can't see any advantage to removing the reference.

 is that what you meant by the " (sort of) "?

Jim.
0

Featured Post

Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question