VBA - Visual Basic for Applications

Recently I had to link tables from one access file in another access file.

I did not intend to document such a trivial task on my webpage, but since the function I copied from the internet ran into an endless loop after I only provided an invalid file path I decided to implement something myself.

Enjoy.

' @Author
'   Alexander Bolte
'
' @ChangeDate
'   2014-07-29
'
' @Description
'   Linking given table from given source Access database in CurrentDb under provided target name.
'   If a linked table already exists under given name, the link will be broken and replaced with the new one.
'
' @Param strDatabaseSource
'   String providing the full path of the source access database.
' @Param strTableSource
'   String providing the source table name in the source access database.
' @Param strTableDestination
'   String providing the target table name in CurrentDB.
' @Return
'   True, if linkage succeeded, else false.
Public Function LinkTable( _
        ByVal strDatabaseSource As String, _
        ByVal strTableSource As String, ByVal strTableDestination As String _
    ) As Boolean
    Dim dbSource As DAO.Database
    Dim dbTarget As DAO.Database
    Dim dbDestination As DAO.Database
    Dim tdf As DAO.TableDef
   
On Error GoTo LinkTable_Err

    Call unlinkTable(strTableDestination)
    Set dbSource = DBEngine.Workspaces(0).OpenDatabase(strDatabaseSource)
    Set dbDestination = CurrentDb
    Set tdf = dbDestination.CreateTableDef(strTableDestination)
    tdf.Connect = ";DATABASE=" & strDatabaseSource
    tdf.SourceTableName = strTableSource
    dbDestination.TableDefs.Append tdf
    LinkTable = True
LinkTable_Err:
    If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, cDialogTitle
Err.Clear
LinkTable = False
    End If
   
    If Not (dbSource Is Nothing) Then
        dbSource.Close
        Set dbSource = Nothing
    End If
    Set dbDestination = Nothing
    Set tdf = Nothing
End Function 

The following methods provide you with three different ways of reading a range into a collection in VBA.

Source Code

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Public Function readRangeIntoTableCollection(ByRef rng As Range, ByVal keyCol As Integer) As Scripting.Dictionary
    Dim i As Long
    Dim j As Integer
    Dim rec As Scripting.Dictionary
    Dim dict As New Scripting.Dictionary
    
    If Not (rng Is Nothing) Then
        If keyCol <> 0 Then
            ' Loop through all rows in a given range object.
            For i = 2 To rng.Rows.Count
                Set rec = New Scripting.Dictionary
                ' Loop through all columns in a given range object.
                For j = 1 To rng.Columns.Count
                    ' Read one record.
                    rec.Add rng.Cells(1, j).value, rng.Cells(i, j).value
                Next j
                ' Add one record to returned collection.
                dict.Add rng.Cells(i, keyCol).value, rec
            Next i
        End If
    End If
    
    Set readRangeIntoTableCollection = dict
End Function
 
' @Author - Alexander Bolte
' @ChangeDate - 2014-10-09
' @Description - Reading a provided Range objects values into a collection holding key value pairs.
' @Param rng - a Range object holding one or more columns.
' @Param keyCol - a column within provided Range holding keys.
' @Param valCol - a column within provided Range holding values.
' @Remarks - The index for columns starts in a provided Range, not in the worksheet.
' If for example the handed Range starts in column C of a worksheet
' and you need the first column of handed Range as keys, you would provide 1 and not 3 as keyCol.
Public Function readRangeIntoCollection(ByRef rng As Range, ByVal keyCol As Integer, ByVal valCol As Integer) As Scripting.Dictionary
    Dim i As Long
    Dim dict As New Scripting.Dictionary
    
    If Not (rng Is Nothing) Then
        If keyCol <> 0 And valCol <> 0 Then
            For i = 1 To rng.Rows.Count
                dict.Add rng.Cells(i, keyCol).value, rng.Cells(i, valCol).value
            Next i
        End If
    End If
    
    Set readRangeIntoCollection = dict
End Function
 
' @Author - Alexander Bolte
' @ChangeDate - 2014-10-09
' @Description - Reading a provided Range objects values into a collection.
' @Param rng - a Range object holding one column.
' @Returns a collection of type VBA.Collection holding all values
' from the first column in provided Range object.
Public Function readRangeIntoVbaCollection(ByRef rng As Range) As VBA.Collection
    Dim i As Long
    Dim dict As New VBA.Collection
    
    If Not (rng Is Nothing) Then
        For i = 1 To rng.Rows.Count
            If rng.Rows(i).Hidden = False Then
                dict.Add Trim(rng.Cells(i, 1).value)
            End If
        Next i
    End If
    
    Set readRangeIntoVbaCollection = dict
End Function

 

 

The following looked simple enough for me.

Source Code

Here a solution, which works for me however you have to be careful since it relies on a certain environment variable to be present. If this environment variable is not available the method automatically assumes the os to operate in 32 bit.

1
2
3
4
5
6
7
8
' @Author - Alexander Bolte
' @ChangeDate - 2016-03-27
' @Description - Determines if a users operating system is of 64 bit or 32 bit.
' In a 32 bit windows operating system the environment variable "ProgramW6432" simply does not exist.
' @Returns true, if the default directory for 32 bit applications is C:\Program Files (x86), else false.
Function Is64bit() As Boolean
    Is64bit = Len(Environ("ProgramW6432")) > 0
End Function

Unfortunately thie below did not work for me as it returned "x86" no matter if I started it on a 64 bit or 32 bit os.

1
2
3
Sub testArchitecture()
    MsgBox Environ("PROCESSOR_ARCHITECTURE")
End Sub

 

Subcategories

This category will hold articles regarding developement in Excel VBA. It will serve as a wiki and an Excel VBA Framework for myself.

Some development tasks reoccur for every customer. Since I am a lazy bum it will be nice to have a central source where I can reuse source code from.

This category holds articles regarding general things in MS Office VBA independent from the MS Office application.  

This category holds articles regarding Access VBA, but also general things I come accross Access and its usage in companies.