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
- Hits: 9968
If you want to join two tables in MS Access using the LIKE operator you will fail receiving an error message stating the following.
"JOIN expression not supported."
MS Access SQL
The SQL producing above error looks as follows.
You can fix this by changing the SQL to define the JOIN condition in the WHERE part of a statement.
- Hits: 9870
The below snippet will provide you with a systems full user name.
Source Code
' @Author - Alexander Bolte
' @ChangeDate - 2014-10-13
' @Description - Returning the system user name.
Public Function getFullUserName() As String
Dim WSHnet As Object
Dim UserFullName As String
Dim userName As String
Dim UserDomain As String
Dim objUser As Object
Set WSHnet = CreateObject("WScript.Network")
userName = WSHnet.userName
UserDomain = WSHnet.UserDomain
Set objUser = GetObject("WinNT://" & UserDomain & "/" & userName & ",user")
UserFullName = objUser.FullName
Set WSHnet = Nothing
Set objUser = Nothing
getFullUserName = UserFullName
End Function
Referenced APIs
Since the source is using late binding it is not necessary to set a reference in the VBA Editor for a specific version of the referenced API named "WScript".
- Hits: 9961
Subcategories
Excel VBA Article Count: 30
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.
MS Office and VBA Article Count: 11
This category holds articles regarding general things in MS Office VBA independent from the MS Office application.
Power Point VBA Article Count: 1
Access VBA Article Count: 7
This category holds articles regarding Access VBA, but also general things I come accross Access and its usage in companies.
Access VBA DAO Article Count: 2
Page 5 of 17