Since I`m in a develop mode and my front ends requires a lot of updates.
This is my function to check the version when the user try to open on of the front end:
Public Function FEPath(DBName As String)
Dim Conn As New ADODB.Connection
Dim DataConn As New ADODB.Recordset
Dim Comm As String
Dim strPath As String
Dim strDB As String
Dim strVer As String
Dim strExt As String
Comm = " SELECT tblFE.Database, tblFE.Version, tblFE.Extension " & _
" FROM tblFE WHERE tblFE.[Database] = '" & DBName & "';"
Set Conn = CurrentProject.Connection
DataConn.Open Comm, Conn, adOpenKeyset, adLockOptimistic
With DataConn
strDB = ![Database]
strVer = ![Version]
strExt = ![Extension]
strPath = "C:\Databases\" & strDB & " " & strVer & strExt
.Close
End With
Set Conn = Nothing
I need to somehow run a piece of code every 30 minutes, while the front end is open, to check to see if there is a new front end version available for upload. I would then notify the user, close the database, and update to the new version. Right now, version updating is always happening when the database opens. How can this be done?
Thank you.
There's an old trick MS Access programmers use. You use an autoexec macro to open a hidden form when your database launches. Then you can use the Form_Timer event to trigger any code that you want to run every so often.
The TimerInterval form property uses milliseconds, so you could either set it manually to 1800000 (1000 * 60 * 30) or use your hidden form's on_load event to set it. I usually opt for option 2 so it's spelled out in the code somewhere.
Sub Form_Load()
Me.TimerInterval = 1000 * 60 * 30 ' 30 minutes
End Sub
Sub Form_Timer()
' check the front end version here
End Sub
*Note: Setting the TimerInterval in the load event also allows you to set it to 0 (effectively turn it off) when you're developing. I don't expect you'll need to with a 30 minute timer, but when you're running something every 1/4 second, form timers can be a pain to work with while developing other places in your database application.
Related
So I have this Access form where I use this VBA code with a DAO connection to a MySQL database. Everything works great but if the user closes the form without clicking save button the new record is saved anyway.
So what I'm looking for is if there's any way the on the on close event I can stop the new record being saved to the database?
The code I have,
Private Sub Form_Load()
'Set Form Recordset
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim SQL As String
Set db = OpenDatabase("", False, False, Globales.ConnString)
SQL = "SELECT tbl6Suplidores.ID, tbl6Suplidores.NombreSuplidor, tbl6Suplidores.NumeroComerciante, tbl6Suplidores.DescripcionBienes, tbl6Suplidores.NombreContacto, tbl6Suplidores.NumeroTelefono, tbl6Suplidores.Email " _
& "FROM tbl6Suplidores;"
Set rs = db.OpenRecordset(SQL, dbOpenDynaset, dbAppendOnly)
Set Me.Form.Recordset = rs
End Sub
I'm thinking that since I used the dbAppendOnly it won't let me just delete current record on close event?
Any ideas welcome!
Thanks!
Consider a different approach where you have users enter an unbound form and click a save button to update the MySQL table from populated fields. Exiting form without save will do nothing. This is also a more proactive approach as it allows you to check validation and other logic prior to running save action.
Below uses a parameterized append query with QueryDefs. Also, ID is assumed to be an autonumber and hence left out of query. Sub should be placed behind the OnClick trigger event of save button.
Private Sub SaveButton_Click()
Dim db As DAO.Database, qdef As DAO.QueryDef
Dim SQL As String
Set db = OpenDatabase("", False, False, Globales.ConnString)
' PREPARED STATEMENT WITH NAMED PARAMETERS
SQL = "PARAMETERS ns_param VARCHAR(255), ncom_param INTEGER, db_param VARCHAR(255), " _
& " ncnt_param INTEGER, nt_param INTEGER, e_param VARCHAR(255);" _
& " INSERT INTO (NombreSuplidor, NumeroComerciante, DescripcionBienes, " _
& " NombreContacto, NumeroTelefono, Email) " _
& " VALUES (ns_param, ncom_param, db_param, ncnt_param, nt_param, e_param);"
' INITIALIZE QUERYDEF
Set qdef = db.CreateQueryDef("", SQL)
' BIND PARAMETERS TO FORM FIELDS
qdef!ns_param = Forms!MyFormName!NombreSuplidor
qdef!ncom_param = Forms!MyFormName!NumeroComerciante
qdef!db_param = Forms!MyFormName!DescripcionBienes
qdef!ncnt_param = Forms!MyFormName!NombreContacto
qdef!nt_biens_param = Forms!MyFormName!NumeroTelefono
qdef!e_param = Forms!MyFormName!Email
' RUN ACTION QUERY
qdef.Execute dbFailOnError
Set qdef = Nothing
End Sub
I have some code, which works perfectly fine, that compacts an Access database when the database is opened.
However, I'm a little stuck as to how to do the next bit.
What I want to happen is that when an item within the DB table gets marked for archive and subsequently archived, I want this code to run almost like an AutoExec.
Could you please suggest the best way of doing this?
Thanks in advance
Option Compare Database
Private Sub Form_Timer()
'==================================================================
'The Timer event runs this code every minute. It compares your
'system time with the StartTime variable. When they match, it
'starts to compact all databases in the DBNames table.
'==================================================================
Dim StartTime As String
' Set this variable for the time you want compacting to start.
StartTime = Now()
' If StartTime is now, open the DBNames table and start compacting
If Format(Now(), "medium time") = Format(StartTime, _
"medium time") Then
Dim RS As Recordset, DB As Database
Dim NewDBName As String, DBName As String
Set DB = CurrentDb()
Set RS = DB.OpenRecordset("DBNames")
On Error Resume Next
RS.MoveFirst
Do Until RS.EOF
DBName = RS("DBFolder") & "\" & RS("DBName")
' Create a new name for the compacted database.
' This example uses the old name plus the current date.
NewDBName = Left(DBName, Len(DBName) - 4)
NewDBName = NewDBName & " " & Format(Date, "DDMMYY") & ".mdb"
DBEngine.CompactDatabase DBName, NewDBName
RS.MoveNext
Loop
' Close the form, and then close Microsoft Access
DoCmd.Close acForm, "CompactDB", acSaveYes
RS.Close
DoCmd.Quit acSaveYes
End If
End Sub
I read through a pretty thorough response in the link How to search through VBA code files and it works just fine for the current project. However, I'm just feeling slow in opening up other projects and looking through their code.
The response mentioned using OpenDatabase but I'm not seeing examples about the association between the database and the Application.VBE.ActiveVBProject. I've not been lazy about this, but 4 days of searching the web has exhausted my options.
Any help would be really appreciated.
My apologies. Found other way to make this work.
Public Sub FindWordInOtherModules(ByVal pSearchWord As String, sApplicationFilePath As String)
Dim objComponent As VBComponent
' VBComponent requires reference to Microsoft Visual Basic
' for Applications Extensibility; use late binding instead:
Dim lStartLine As Long
Dim lEndLine As Long
Dim lStartColumn As Long
Dim lEndColumn As Long
Dim accApp As Access.Application
Set accApp = New Access.Application
With accApp
.Visible = True
.OpenCurrentDatabase (sApplicationFilePath)
.UserControl = True
'MsgBox .VBE.ActiveVBProject.VBComponents.Count
'MsgBox .CurrentDb.Name
For Each objComponent In .VBE.ActiveVBProject.VBComponents
If objComponent.CodeModule.Find(pSearchWord, lStartLine, lStartColumn, lEndLine, lEndColumn, _
FindWholeWord, MatchCase, PatternSearch) = True Then
MsgBox "Found text " & StringToFind & vbCrLf _
& "Start line: " & lStartLine & vbCrLf _
& "Line text: " & objComponent.CodeModule.Lines(lStartLine, lEndLine - lStartLine + 1), vbOKOnly, objComponent.CodeModule.Name
End If
Next objComponent
End With
accApp.CloseCurrentDatabase
Set accApp = Nothing
End Sub
You should probably add accApp.Quit:
accApp.CloseCurrentDatabase
accApp.Quit
Set accApp = Nothing
before Set accApp = Nothing to speed up closing the application and close it during execution of this code (Public Sub FindWordInOtherModules), on the line accApp.Quit, not later. On my computer mouse is still inactive several seconds after execution such kind of Sub if accApp.Quit is not added.
But there is no need to open another database, because the current database can be only "linked' to it by creating temporary reference:
Private Sub FindWordInOtherModules2()
Dim objComponent As VBComponent
...
...
Dim lEndColumn As Long
Dim ref As Reference
Dim RefName As String
Const FileName = "C:\Users\....mdb"
With Application 'instead of accApp
.References.AddFromFile FileName
'.References.Count because the new one is supposed be the last one (?)
RefName = .References(.References.Count).Name
Dim VBProj As VBProject
For Each VBProj In .VBE.VBProjects
If VBProj.FileName <> .CurrentDb.Name Then Exit For
Next
For Each objComponent In VBProj.VBComponents
'Debug.Print objComponent.Name
...
...
Next
Set objComponent = Nothing '?
Set VBProj = Nothing '?
Set ref = .References(RefName)
.References.Remove ref
Set ref = Nothing '??
End With
End Sub
This seems be faster then opening another database file, but VBA can't be updated.
References.Remove ref removes reference, but VBA folders are still visible in the left panel and all the code works, what is a little disturbing ...
Application.VBE.VBProjects.Remove VBProj doesn't work. It may have something to do with "Trust access to the VBA project object model" option in Trust Center - Macro Settings, which is not available in Access.
But the project is not visible after closing and opening the database.
I am working on a system that has been in use since the 90's. Written in VB6, it was originally setup to utilize an Access Database and the JET driver.
Now, since we have clients running up against the 2GB file size limit on Access DBs, we are looking into converting everything over to mySQL.
Unfortunately, everything in the system that was written prior to about 5 years ago is using this type of logic:
Dim rst As New ADODB.Recordset
rst.ActiveConnection = cnn
rst.Open "table"
rst.Index = "index"
rst.Seek Array("field1", "field2"), adSeekFirstEQ
rst!field1 = "something new"
rst.Update
The newer code is using SQL commands like SELECT, UPDATE, etc.
So, what we're hoping to do is to phase in the new mySQL DBs for our clients - get them the DB setup but using all the old code.
The problem is that I can't use Index when using the SQL db... everything else seems to work fine except for that.
I get the error: #3251: Current provider does not support the necessary interface for Index functionality.
Is there something I'm missing? Is there another way to so a Seek when using SQL so that I can sort by my Index? Or will I have to go in and change the entire system and remove all the Seek logic - which is used THOUSANDS of times? This is particularly an issue for all of our Reports where we might have a Table with an Index where Col 1 is sorted ASC, Col 2 is sorted DESC, Col 3 is ASC again and I need to find the first 5 records where Col 1 = X. How else would you do it?
Since, as you posted, the DB doesn't support Seek or Index, you're kind of out of luck as far as that is concerned.
However, if you really must use seek /index I'd suggest importing the result of the SQL query into a local .mdb file and then using that to make the recordset work like the rest of the code expects.
This is slightly evil from a performance point of view, and honestly it may be better to replace all the seeks and index calls in the long run anyways, but at least it'll save you time coding.
For creating the local db you can do:
Function dimdbs(Temptable as String)
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim strDbfullpath As String
Dim dbsn As Database
Dim idx As Index
Dim autofld As Field
'PARAMETERS: DBFULLPATH: FileName/Path of database to create
strDbfullpath = VBA.Environ$("TMP") & "\mydb.mdb"
If Dir(strDbfullpath) <> "" Then
Set dbsn = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Set dbsn = DBEngine.CreateDatabase(strDbfullpath, dbLangGeneral)
End If
Set tdfNew = dbsn.CreateTableDef(Temptable)
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.
Set autofld = .CreateField("autonum", dbLong)
autofld.Attributes = dbAutoIncrField
.Fields.Append autofld
.Fields.Append .CreateField("foo", dbText, 3)
.Fields.Append .CreateField("bar", dbLong)
.Fields.Append .CreateField("foobar", dbText, 30)
.Fields("foobar").AllowZeroLength = True
Set idx = .CreateIndex("PrimaryKey")
idx.Fields.Append .CreateField("autonum")
idx.Unique = True
idx.Primary = True
.Indexes.Append idx
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
If ObjectExists("Table", Temptable & "CompletedCourses", "Userdb") Then
dbsn.Execute "Delete * FROM " & Temptable & "CompletedCourses"
Else
dbsn.TableDefs.Append tdfNew
End If
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
Set idx = Nothing
Set autofld = Nothing
End Function
to find and delete it later you can use the following:
Function DeleteAllTempTables(strTempString As String, Optional tmpdbname As String = "\mydb.mdb", Optional strpath As String = "%TMP%")
Dim dbs2 As Database
Dim t As dao.TableDef, I As Integer
Dim strDbfullpath
If strpath = "%TMP%" Then
strpath = VBA.Environ$("TMP")
End If
strDbfullpath = strpath & tmpdbname
If Dir(strDbfullpath) <> "" Then
Set dbs2 = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Exit Function
End If
strTempString = strTempString & "*"
For I = dbs2.TableDefs.Count - 1 To 0 Step -1
Set t = dbs2.TableDefs(I)
If t.Name Like strTempString Then
dbs2.TableDefs.Delete t.Name
End If
Next I
dbs2.Close
End Function
To import from SQL to that DB you'll have to get the recordset and add each record in using a for loop (unless it's a fixed ODBC connection, i think you can import directly but I don't have example code)
Dim formrst As New ADODB.recordset
Set mysqlconn = New ADODB.Connection
Dim dbsRst As recordset
Dim dbs As Database
'opens the ADODB connection to my database
Call openConnect(mysqlconn)
'calls the above function to create the temp database
'Temptable is defined as a form-level variable so it can be unique to this form
'and other forms/reports don't delete it
Call dimdbs(Temptable)
Me.RecordSource = "SELECT * FROM [" & Temptable & "] IN '" & VBA.Environ$("TMP") & "\mydb.mdb'"
Set dbs = DBEngine.Workspaces(0).OpenDatabase(VBA.Environ$("TMP") & "\mydb.mdb")
Set dbsRst = dbs.OpenRecordset(Temptable)
Set formrst.ActiveConnection = mysqlconn
Call Selectquery(formrst, strSQL & strwhere & SQLorderby, adLockReadOnly, adOpenForwardOnly)
With formrst
Do Until .EOF
dbsRst.AddNew
dbsRst!foo = !foo
dbsRst!bar = !bar
dbsRst!foobar = !foobar
dbsRst.Update
.MoveNext
Loop
.Close
End With
dbsRst.Close
Set dbsRst = Nothing
dbs.Close
Set formrst = Nothing
You'll have to re-import the data on save or on form close at the end, but at least that will only need one SQL statement, or you can do it directly with the ODBC connection.
This is by far less than optimal but at least you can couch all this code inside one or two extra function calls and it won't disturb the original logic.
I have to give huge credit to Allen Browne, I pulled this code from all over the place but most my code probably comes from or has been inspired by his site (http://allenbrowne.com/)
Who wants to use VB6? Nevertheless...
When you do not specify Provider, you can't use Index property. As far as i know only OleDb for MS Jet supports *Seek* method and *Index* property.
Please read this:
Seek method - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675109%28v=vs.85%29.aspx
Index property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675255%28v=vs.85%29.aspx
ConnectionString property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675810%28v=vs.85%29.aspx
Provider property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675096%28v=vs.85%29.aspx
For further information, please see: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681510%28v=vs.85%29.aspx
[EDIT]
After your comments...
I would strongly recommend to download and install Visual Studio Express Edition and use VB.NET instead VB6. Than install ADO.NET MySQL Connector and re-write application, using the newest technology rather than torturing yourself with ADODB objects, etc.
Examples:
Connecting to MySQL databases using VB.NET
[/EDIT]
I actually have 2 questions:
1. How might I see who is using my Access database?
E.g: There is someone with an Access database opened and it created the .ldb file, I would like to see a list of who opened that database (it could be more than one person).
2. How might I see who is using a linked table?
E.g: I have 10 different Access databases, and all of them are using a same linked table. I would like to see who is using that linked table.
I don't even know if it's really possible, but I really appreciate your help!
For you information: The main problem is that lots of people use the same Access in the same network drive, so when I need to change it I have to kick them all out, but I never know who is actually using it.
Update: Rather than reading and parsing the .ldb/.lacdb file, a better approach would be to use the "User Roster" feature of the Access OLEDB provider as described in the Knowledge Base article
https://support.microsoft.com/en-us/kb/285822
and in the other SO question
Get contents of laccdb file through VBA
Original answer:
I put together the following a while ago. It looked promising but then I discovered that computers are not immediately removed from the lock file when they disconnect. Instead, Jet/ACE seems to (internally) mark them as inactive: If ComputerA disconnects and then ComputerB connects, ComputerB overwrites ComputerA's entry in the lock file.
Still, it does provide a list of sorts. I'm posting it here in case somebody can offer some suggestions for refinement.
I created two tables in my back-end database:
Table: [CurrentConnections]
computerName Text(255), Primary Key
Table: [ConnectionLog]
computerName Text(255), Primary Key
userName Text(255)
A VBA Module in my back-end database contained the following code to read (a copy of) the lock file and update the [CurrentConnections] table:
Public Sub GetCurrentlyConnectedMachines()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim fso As Object '' FileSystemObject
Dim lck As Object '' ADODB.Stream
Dim lockFileSpec As String, lockFileExt As String, tempFileSpec As String
Dim buffer() As Byte
Set cdb = CurrentDb
cdb.Execute "DELETE FROM CurrentConnections", dbFailOnError
Set rst = cdb.OpenRecordset("SELECT computerName FROM CurrentConnections", dbOpenDynaset)
lockFileSpec = Application.CurrentDb.Name
If Right(lockFileSpec, 6) = ".accdb" Then
lockFileExt = ".laccdb"
Else
lockFileExt = ".ldb"
End If
lockFileSpec = Left(lockFileSpec, InStrRev(lockFileSpec, ".", -1, vbBinaryCompare) - 1) & lockFileExt
'' ADODB.Stream cannot open the lock file in-place, so copy it to %TEMP%
Set fso = CreateObject("Scripting.FileSystemObject") '' New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName
fso.CopyFile lockFileSpec, tempFileSpec, True
Set lck = CreateObject("ADODB.Stream") '' New ADODB.Stream
lck.Type = 1 '' adTypeBinary
lck.Open
lck.LoadFromFile tempFileSpec
Do While Not lck.EOS
buffer = lck.Read(32)
rst.AddNew
rst!computerName = DecodeSZ(buffer)
rst.Update
buffer = lck.Read(32) '' skip accessUserId, (almost) always "Admin"
Loop
lck.Close
Set lck = Nothing
rst.Close
Set rst = Nothing
Set cdb = Nothing
fso.DeleteFile tempFileSpec
Set fso = Nothing
End Sub
Private Function DecodeSZ(buf() As Byte) As String
Dim b As Variant, rt As String
rt = ""
For Each b In buf
If b = 0 Then
Exit For '' null terminates the string
End If
rt = rt & Chr(b)
Next
DecodeSZ = rt
End Function
The following code in the Main_Menu form of the front-end database updated the [ConnectionLog] table
Private Sub Form_Load()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim wshNet As Object '' WshNetwork
Set wshNet = CreateObject("Wscript.Network")
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT * FROM ConnectionLog", dbOpenDynaset)
rst.FindFirst "ComputerName=""" & wshNet.computerName & """"
If rst.NoMatch Then
rst.AddNew
rst!computerName = wshNet.computerName
Else
rst.Edit
End If
rst!userName = wshNet.userName
rst.Update
Set wshNet = Nothing
End Sub
Finally, the following form in the back-end database listed [its best guess at] the current connections
It is a "continuous forms" form whose Record Source is
SELECT CurrentConnections.computerName, ConnectionLog.userName
FROM CurrentConnections LEFT JOIN ConnectionLog
ON CurrentConnections.computerName = ConnectionLog.computerName
ORDER BY ConnectionLog.userName;
and the code-behind is simply
Private Sub Form_Load()
UpdateFormData
End Sub
Private Sub cmdRefresh_Click()
UpdateFormData
End Sub
Private Sub UpdateFormData()
GetCurrentlyConnectedMachines
Me.Requery
End Sub
Easy. Open the .ldb file in notepad (or any text editor) and you can see the machine names.
RE: How might I see who is using my Access database?
•E.g: There is someone with an Access database opened and it created the .ldb file, I would like to see a list of who opened that database (it could be more than one person).
Just happened across this while looking for something else, and I thought I might share what I do for this. Note that this assumes that the host computer (the computer on which the database file resides) uses file sharing to provide access to the file.
You will need to be on the host computer, or have authority to connect to that machine.
click Start
right-click My Computer and select Manage
if you're not on the host computer, right-click 'Computer Management' and enter the host's name
Expand 'Shared Folders' and click on 'Open Files'
At the right is the list of currently open files with the username for each current user
I agree with Gord's Original answer. I used this code on my database, it seems that there is a way around computers not being taken out of CurrentConnections upon exit of the DB.
I placed this on my main menu form because it is always open until the user exits. I used the unload event on my form to get this to work, and it works awesome! Here is my code
p.s. Ignore SetWarnings I just have that on so the user doesn't have to click through prompts.
Private Sub Form_Unload(Cancel As Integer)
Dim wshNet As Object
Dim deleteSQL As String
Set wshNet = CreateObject("WScript.Network")
DoCmd.SetWarnings False
deleteSQL = "DELETE tblCurrentConnections.* " & _
"FROM tblCurrentConnections WHERE[computerName] = '" & wshNet.computerName & "';"
DoCmd.RunSQL deleteSQL
DoCmd.SetWarnings True
End Sub