Solved

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

Posted on 2014-01-23
21
356 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
 

Author Comment

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

Thanks,
gdunn59
0
 
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
 

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
 

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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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
 

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
 

Author Comment

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

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
 

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 34

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
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 …
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

746 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now