How to find current MS Access database path - ms-access

I have a MS Access application connected to a MS Access database, what I want is to show the path of the database in a textbox.
For example, let the database path be D:\New Folder\Database\Test.accdb
How can this path be shown in the text box?
I tried this code but it doesn't work
Me.Text71 = CurrentDb.Path

If you want to get the path name of the backend database you could use the following code in order to get the name of the backend database.
Put the following code in a general module (Insert/Module)
Public Function getDBname(tblName As String) As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim con() As String
Dim i As Long
On Error GoTo EH
Set db = CurrentDb
Set tdf = db.TableDefs(tblName)
con = Split(tdf.Connect, ";")
For i = 0 To UBound(con)
If Left(con(i), 9) = "DATABASE=" Then
getDBname = Mid(con(i), 10)
End If
Next i
EH:
End Function
Then you could use
Me.Text71 = getDBname ("tbl1")
tbl1 has to be the name of a linked table from the backend database you are after.
As mentioned in the comments a frontend could be connected to different backend databases. So, use with care.

Related

How to link tables with VBA code over ODBC

Actually I use a ODBC-Connection to connect Ms Acces to tables of a PostgreSQL-DB. I connect them by using the External Data/Import ODBC-Link command. It works fine.
But how can I use VBA to link my tables?
When using VBA to link a table with ODBC, you can add and APP= argument to specify an application name that will generally show in the properties of the connection on your database server.
For example, here is a sample ODBC Connection string for a linked table:
ODBC;Driver={SQL Server};Server=MyServer\SQLExpress;Database=MyDatabase;APP=My App Title;Trusted_Connection=Yes;
My App Title is the string that will be your Application Name for that connection.
Update 1 In response to further comment by the OP:
Here is sample code to link a table via ODBC in VBA. To facilitate this, you also should always delete the ODBC linked table each time before re-linking it to make sure that your options are respected, and that Microsoft Access updates the schema for the linked table. This example shows a connection string for a SQL Server database, so all you would need to change is the connection string for your PostgreSQL-DB. The remaining VBA code would be the same.
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strConn As String
Dim ODBCTableName as String
Dim AccessTableName as String
Set db = CurrentDb()
ODBCTableName = "dbo.YourTable"
AccessTableName = "YourTable"
strConn = "ODBC;Driver={SQL Server};Server=YOURSERVER\SQLINSTANCE;Database=MYDATABASE;Trusted_Connection=No;UID=MyUserName;PWD=MyPassword"
db.TableDefs.Refresh
For Each tdf In db.TableDefs
If tdf.Name = AccessTableName Then
db.TableDefs.Delete tdf.Name
Exit For
End If
Next tdf
Set tdf = db.CreateTableDef(AccessTableName)
'===============================
'If your connection string includes a password
'and you want the password to be saved, include the following 3 lines of code
'to specify the dbAttachSavePWD attribute of the TableDef being created
'If you don't want to save the password, you would omit these 3 lines of code
'===============================
If InStr(strConn, "PWD=") Then
tdf.Attributes = dbAttachSavePWD
End If
tdf.SourceTableName = ODBCTableName
tdf.Connect = strConn
db.TableDefs.Append tdf
For some reason this code gives Run time error 3170 - Could not find installable ISAM. However, when you add ODBC; at the beginning of the connection string, then it works. So the connection string should look something like:
strConn = "ODBC;DRIVER={MySQL ODBC 5.2 Unicode Driver};" _
& "SERVER=servername;" _
& "DATABASE=databasename;" _
& "UID=username;PWD=password; OPTION=3"

Launch password protected database and close existing one

I am trying to set up a "Launcher" database which contains VBA code that will open a second database which is password protected. I can then convert the launcher db to accde so the VBA containing the password cannot be read.
I have the following code so far.
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
Set db = acc.DBEngine.OpenDatabase(strDbName, False, False, ";PWD=swordfish")
acc.OpenCurrentDatabase (strDbName)
Application.Quit
End Sub
When the launcher db is opened a form loads which subsequently fires the above code. It works but the problem is the last line which is intended to close the launcher db only but closes both databases. I have also tried opening the main database using Shell but am unable to pass the password this way.
How can I close the first database while keeping the second open?
You can use the following:
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
acc.OpenCurrentDatabase strDbName, False, "swordfish"
Set db = acc.CurrentDb() 'Don't know why you want a reference to the db
acc.UserControl = True
Application.Quit
End Sub
The relevant part is acc.UserControl = True, that forces the DB to stay visible and stops it from closing as soon as the reference to the Application object gets destroyed.
A sample database that stores the main database password encrypted with a salted user password can be found in this answer
I was having trouble getting the accepted answer to work properly. I was able to make work with:
Public Function OpenAccessDb(strVerPath, strFileName, sRecordset, strPwd)
'You may also need to have the following References Added:
'Microsoft Access 16.0 Object Library & Microsoft Office 16.0 Access Database Engine Object
'Visual Basic for Applications// Microsoft Excel 16.0 Object Library// OLE Automation//
'Microsoft Forms 2.0 Object Library// Microsoft Outlook 16.0 Object Library// Microsoft Office 16.0 Object Library
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim sPath As String
'sPath = GetProperDirectory(strVerPath, strFileName) ' you can bypass this function by setting the path manually below and commenting this out.
sPath = "C:\database Folder\secureDB.accdb"'manually set the path here and comment out line above
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath, False, True, "MS Access;PWD=" & strPwd)
Set oRS = oDB.OpenRecordset(sRecordset)
''paste to call this function
''note this function utilizes the GetProperDirectory function.
''The GetProperDirectory function uses xxxxx as the location source
''therefore the strVerPath should start after \xxxxx\yyyyyy\yyyyy\DB.accdb
'strVerPath = "\yyyyyy\yyyyy\"
'strFileName= "DB.accdb"
'sRecordSet= "table in access DB" 'the table you are sending the data to
'strPwd = "password' 'this is the password that allows access to the database
'booOpenSend= OpenAccessDb(strVerPath, strFileName, sRecordSet, strPwd)
''end paste
End Function

How to copy the contents of an attached file from an MS Access DB into a VBA variable?

Background Information:
I am not very savvy with VBA, or Access for that matter, but I have a VBA script that creates a file (a KML to be specific, but this won't matter much for my question) on the users computer and writes to it using variables that link to records in the database. As such:
Dim MyDB As Database
Dim MyRS As Recordset
Dim QryOrTblDef As String
Dim TestFile As Integer
QryOrTblDef = "Table1"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(QryOrTblDef)
TestFile = FreeFile
Open "C:\Testing.txt"
Print #TestFile, "Generic Stuff"
Print #TestFile, MyRS.Fields(0)
etc.
My Situation:
I have a very large string(a text document with a large list of polygon vertex coordinates) that I want to add to a variable to be printed to another file (a KML file, noted in the above example). I was hoping to add this text file containing coordinates as an attachment datatype to the Access database and copy its contents into a variable to be used in the above script.
My Question:
Is there a way I can access and copy the data from an attached text file (attached as an attachment data type within a field of an MS Access database) into a variable so that I can use it in a VBA script?
What I have found:
I am having trouble finidng information on this topic I think mainly because I do not have the knowledge of what keywords to be searching for, but I was able to find someones code on a forum, "ozgrid", that seems to be close to what I want to do. Though it is just pulling from a text file on disk rather than one attached to the database.
Code from above mentioned forum that creates a function to access data in a text file:
Sub Test()
Dim strText As String
strText = GetFileContent("C:\temp\x.txt")
MsgBox strText
End Sub
Function GetFileContent(Name As String) As String
Dim intUnit As Integer
On Error Goto ErrGetFileContent
intUnit = FreeFile
Open Name For Input As intUnit
GetFileContent = Input(LOF(intUnit), intUnit)
ErrGetFileContent:
Close intUnit
Exit Function
End Function
Any help here is appreciated. Thanks.
I am a little puzzled as to why a memo data type does not suit if you are storing pure text, or even a table for organized text. That being said, one way is to output to disk and read into a string.
''Ref: Windows Script Host Object Model
Dim fs As New FileSystemObject
Dim ts As TextStream
Dim rs As DAO.Recordset, rsA As DAO.Recordset
Dim sFilePath As String
Dim sFileText As String
sFilePath = "z:\docs\"
Set rs = CurrentDb.OpenRecordset("maintable")
Set rsA = rs.Fields("aAttachment").Value
''File exists
If Not fs.FileExists(sFilePath & rsA.Fields("FileName").Value) Then
''It will save with the existing FileName, but you can assign a new name
rsA.Fields("FileData").SaveToFile sFilePath
End If
Set ts = fs.OpenTextFile(sFilePath _
& rsA.Fields("FileName").Value, ForReading)
sFileText = ts.ReadAll
See also: http://msdn.microsoft.com/en-us/library/office/ff835669.aspx

Setting decimal places in an MDB database

Part of a project I am working on is programmatically create a series of MDB files which will be the final deliverables. The specs from the client ask for some fields in the tables to have 3 decimal places.
I create the mdb files using python at first, and then to be able to alter the columns to DECIMAL (10,3), I use ADODB (C#, .NET 4.0) - as i couldn't find something suitable in Python. Problem though is that this will not be enough for the client. They want to open the MDB and in Design Mode to see the Decimal places for these fields to be set to 3. If they are not, the file is not accepted.
It has now taken me the best part of 3 days trying to come up with a solution. One likely candidate was DAO and the Field2 object but this object has so far eluded me. I am using the Microsoft DAO 3.6 Objects but Field2 doesn't seem to be part of the assembly. And dont even know if this will actually do what is required...
Does anyone know a way to do this? Don't care if its DAO, ADO, OLEDB or any other 3 letter acronym to be honest? How can I get from this:
to this - PROGRAMMATICALLY??
I can tell you how to do this in VBA/DAO, which may give you some ideas. You must append the property first:
sSQL = "create table testX (id counter, anumber decimal(10,3))"
CurrentProject.Connection.Execute sSQL
Dim db As Database
Dim tdf As TableDef
Dim fld As dao.Field
Set db = CurrentDb
Set tdf = db.TableDefs("testX")
Set fld = tdf.Fields("anumber")
'fld.Properties("DecimalPlaces") = 3
Set prp = fld.CreateProperty("DecimalPlaces", dbByte, 3)
tdf.Fields("anumber").Properties.Append prp
Public Sub DBF_SetDecPoints(ByVal DBNom As String, ByVal DBTab As String, ByVal Campo As String, ByVal NDEC As Short)
Dim DB As DAO.Database
Dim TD As DAO.TableDef
Dim FD As DAO.Field
Dim PP As DAO.Property
If DBF_Exists(DBNom, DBTab, Campo) Then
'Call DBF_SetProperty(DBNom$, DBTab$, Campo$, "Format", DaoText, "Fixed")
DB = DAOEngine.Workspaces(0).OpenDatabase(DBNom)
TD = DB.TableDefs(DBTab)
FD = TD.Fields(Campo)
PP = FD.CreateProperty("Format", DaoText, "Fixed")
On Error Resume Next
FD.Properties.Append(PP)
FD.Properties("Format").Value = "Fixed"
PP = FD.CreateProperty("DecimalPlaces", DaoByte, NDEC)
FD.Properties.Append(PP)
FD.Properties("DecimalPlaces").Value = NDEC
On Error GoTo 0
DB.Close()
End If
End Sub

Updating MS Access Linked Table from VBS file

I am currently working on moving 100s of access databases from a variety of folders to another set of folders and need to update any references to linked tables that will be broken during the move. I have identified how to update the location of the linked database table by adding a macro to the access database itself by doing something like the following:
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
' My Logic for checking to see if it is is a linked
' table and then updating it appropriately
Next
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
However, I do not want to have to add the code to each of the access databases so I was wondering if there was a way to create a VBS file which would execute the same type of logic. I tried the following code, but I am getting the following error when the line with the for each logic is executed: "Arguments are of the wrong type, are out of acceptable range or are in conflict with one another"
Set MyConn = CreateObject("ADODB.Connection")
MyConn.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source = MyFile.mdb"
for each tblLoop in db.TableDefs
' business logic
next
set tblLoop = nothing
MyConn.close
set MyConn = nothing
I'm hoping that someone more familiar with doing this type of coding will be able to point me in the right direction. Is there a way to utilize the TableDefs table from outside of Access through a VBS file and if so, what would that code look like.
Thanks,
Jeremy
You cannot use tabledefs with ADO, but you can open the database in VBScript:
Dim db ''As DAO.Database
Dim ac ''As Access Application
''As noted by wmajors81, OpenDatabase is not a method of the application object
''OpenDatabase works with DBEngine: http://support.microsoft.com/kb/152400
Set ac = CreateObject("Access.Application")
ac.OpenCurrentDatabase("c:\test.mdb")
Set db = ac.CurrentDatabase
For Each tdf In db.TableDefs
Etc.
If you have start up code or forms, or database passwords, you will run into some problems, but these can be overcome, for the most part, by simulating the shift key press. This would be easier, I think, in VBA than VBScript, but AFAIK it is possible in VBScript. database passwords can be supplied in the OpenDatabase action.
I was able to expand upon the answer by #Remou to come up with some code that worked. Part of his answer included the following statement which threw an error "Set db = ac.OpenDatabase". As far as I can tell "OpenDatabase" is not a valid method, but OPenCurrentDatabase is. Also, I was getting an error when trying to set db equal to the value returned by OpenCurrentDatabase so I'm assuming that it is a sub and not a function. However, I was able to get access to the Current Database by utilizing ac.CurrentDB once I had established the connection to the the database utilizing OpenCurrentDatabase
Dim db ''As DAO.Database
Dim ac ''As Access Application
Set ac = CreateObject("Access.Application")
ac.OpenCurrentDatabase("D:\delete\UpdatingLinkedTableInAccess\GrpLfRsvs201108.mdb")
set db = ac.CurrentDB
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left(.Connect, 4) = "ODBC" Then
' ignore these are connected via ODBC and are out of scope
Else
' biz logic
End If
End If
End With
next
set db = nothing
ac.Quit
set ac = nothing
Thanks again #Remou for your assistance.
You don't need to create an Access application instance. Use DBEngine and DAO.Workspace instead.
Option Explicit
Dim db
Dim dbe
Dim strDbPath
Dim tdf
Dim wrkJet
strDbPath = "C:\Access\webforums\whiteboard2003.mdb"
Set dbe = CreateObject("DAO.DBEngine.36")
Set wrkJet = dbe.CreateWorkspace("", "admin", "", 2) ' dbUseJet = 2
' exclusive = True and read-only = False '
Set db = wrkJet.OpenDatabase(strDbPath, True, False)
For Each tdf In db.TableDefs
If Left(tdf.Connect, 10) = ";DATABASE=" Then
WScript.Echo tdf.Connect
End If
Next
db.Close
Set db = Nothing
Set wrkJet = Nothing
Set dbe = Nothing
You would need "DAO.DBEngine.120" for ACCDB format database.
If you're using a database password, include it in OpenDatabase.
Set db = wrkJet.OpenDatabase(strDbPath, True, False, ";pwd=password")