I'm having an issue with my databases. I have multiple access databases that share the same pool of users and passwords. They reference the table of users and passwords by a linked table to the 'master' database (the backend that holds the tables for users and passwords). I also have a table that stores the current users and the databases that they are logged into. The problem I'm encountering is that my logout method is not actually logging them out. This is what it is roughly:
'this code is run on click of exit button
Public Sub logout(UserName As String, database As String)
On Error Resume Next
Dim dbMine As DAO.database
Set dbMine = CurrentDb
Dim qr As String
qr = "DELETE * FROM tblCurrentUsers WHERE username = '" & UserName & "' AND Database = '" & database & "' ;"
'debug.print qr
dbMine.Execute qr
Application.Quit
End Sub
The problem is, the records don't seem to be deleting. Do I need to set my database object to the source table instead of referencing the linked table that exists in the database on which the code is run? If so, do I just reference that database by relative path?
Add dbFailOnError option when executing query to catch the error details. See what error you get; that could help you in resolving of your issue.
Public Sub logout(UserName As String, database As String)
On Error GoTo mError:
Dim dbMine As DAO.database
Set dbMine = CurrentDb
Dim qr As String
qr = "DELETE * FROM tblCurrentUsers WHERE username = '" & UserName & "' AND Database = '" & database & "' ;"
'debug.print qr
dbMine.Execute qr, dbFailOnError
Application.Quit
Exit Sub
mError:
MsgBox "Error: " & Err.Description
End Sub
Try using
Set dbMine = DBEngine.Workspaces(0).Databases(0)
instead of
Set dbMine = CurrentDb
I've had similar issues when using CurrentDb. According to http://msdn.microsoft.com/en-us/library/office/bb237861(v=office.12).aspx,
The CurrentDb method creates another instance of the current database, while the DBEngine.Workspaces(0).Databases(0) syntax refers to the open copy of the current database.
Perhaps there's some subtle difference in the way DAO or Access handles the "new instance of the current database".
Related
I have an MS Access db split FE/BE on a network file share, that holds employee "Roster" info - Name, Division, Unit, Work location etc.
I recently added a simpler feature for updating "DivisionUnit" than what existed previously.
I also added code that - when "DivisionUnit" table records are updated - loops through Employee "Roster" table records and changes all impacted rows. This had to be done through code because "DivisionUnit" table was never linked to "Roster" table - which would have facilitated cascading updates.
Here's the Edit Code:
Public Sub EditDivision(aDivisionName As String, aUnitName As String)
Const SUB_NAME As String = "EditDivision"
Dim t As TTracking
Dim rsTarget As ADODB.Recordset
Set rsTarget = New ADODB.Recordset
Dim con As ADODB.Connection
Dim strTarget As String
Dim res As Variant
On Error GoTo ErrCond
s1 = Me.Division.OldValue
s2 = Me.Unit.OldValue
Set con = New ADODB.Connection
Set con = CurrentProject.Connection
Set rsTarget = New ADODB.Recordset
strTarget = "SELECT * from ROSTER where DivisionID = '" & s1 & "' and UnitID = '" & s2 & "'"
rsTarget.Open strTarget, con, adOpenDynamic, adLockOptimistic
With rsTarget
Do Until .EOF
'r1.EditMode
'rsTarget.Update
rsTarget!DivisionID = Me.Division.Value
rsTarget!UnitID = Me.Unit.Value
rsTarget.Update
rsTarget.MoveNext
DoEvents
Loop
End With
Exit Sub:
con.Close
rsTarget.Close
Set con = Nothing
Set rsTarget = Nothing
Me.Refresh
Exit Sub
ErrCond:
EventLogging AppSession.UserName, MSG_TYPE_ERROR, Err.Number, Err.Description, MOD_NAME & "." & SUB_NAME, AppSession.AppSilent
End Sub
In the above code, s1 and s2 are Public variables declared as String
The problem:
There has been a persistent - intermittent - bug:
(If the picture doesn't come through, it's Error 2467 "The expression you entered refers to an object that is closed or doesn't exit)
This is not the first time - or the first application on this share - that has generated this intermittent bug. Closing and reopening the object has consistently fixed the issue in the past, and the bug disappears for months (or a year) on end. Unfortunately, I've been informed that that workaround is unacceptable, and a permanent solution needs to be found.
I've scoured the internet as best I can. Possible causes and solutions are vague and all over the place - Graphics card, conflicting programs, anti-virus, etc.
How can I fix this intermittent issue?
I'm wondering if using DAO vs ADO is the solution here? And, if it is, we're soon moving to SQL Server backend. Will this bug return when I change code back from DAO to ADO for the purposes of connecting to SQL Server?
UPDATE 03/28/2022
Followed guidance to simplify the code, I am just running the following SQL Update statement
Public Sub EditDivision(aDivisionName As String, aUnitName As String)
Const SUB_NAME As String = "EditDivision"
Dim t As TTracking
On Error GoTo ErrCond
s1 = Me.Division.OldValue
s2 = Me.Unit.OldValue
DoCmd.RunSQL "UPDATE Roster SET DivisionID= '" & Me.Division.Value & "' and UnitID='" & Me.Unit.Value & "' WHERE DivisionID = '" & s1 & "' and UnitID='" & s2 & "'"
Me.Refresh
Exit Sub
ErrCond:
EventLogging AppSession.UserName, MSG_TYPE_ERROR, Err.Number, Err.Description, MOD_NAME & "." & SUB_NAME, AppSession.AppSilent
End Sub
Problem: In testing a change to Division, Division is being changed to -1
I can't even begin to explain HOW, when -1 is a boolean value. I will say that this application is overtly complicates. There is a lot of background VBA that runs through a host of permissions and table setting modules before a form even open.
I tried stepping through the code, and the SQL statement captured the values I WANTED to save to the table. But, once the code finishes running, -1 is what's saved instead.
I'm going to try and pause the code before it finishes running through the extraneous modules, and see if that helps. But I'm at a loss here.
I have a project in Access VBA where I need to automate the import of the CSV file (MAX 15MB) into linked SQLITE db. All done on a local machine.
Something similar as for MS SQL (as written below) that would be achievable via query or VBA?
strConn = "DRIVER=ODBC Driver 13 for SQL Server;Server=" & serv & ";Database=" & databs & ";Uid=" & usern & ";Password=" & pwd & ";"
cn.Open strConn
Strsql1 = "BULK INSERT dbo.SEARCHUSRTABLE2 FROM '" & insertfile & "' WITH(FIELDTERMINATOR = ',',ROWTERMINATOR = '\n');"
Set rs = cn.Execute(Strsql)
Ok, we need a few things.
First up, we need from Access:
Browse to csv file – select
Import the csv file to a table.
Now, export to a SQLite.
But, we missing a few questions here.
First up, is the SQLite database the same database and in the same location all the time?
Have you installed the SQLite ODBC driver, and have you been able to link to SQLite from Access?
So, we kind of need the above all sorted out. Especially the connection to SQLite.
And it not clear if you plan/want to create a new table for each csv import, or you going to clear out a table, and re-fill?
Lets assume the following:
You have a linked table to SQLite working from Access.
You can click on this linked table in Access, and you can see/view and even edit the data FROM Access, but the database and table is of course a linked table to SQLite.
If all the above is working?
And ALL of the above so far takes ZERO code. So you “need” to get the above part working.
And we assume that each csv import is to create a new table in the SQLite database?
Then the code would look like this:
Paste this sub into a standard access code module.
Save it, and then with cursor anywhere in the code, hit f5 to run.
Sub CsvImportToSQL()
Dim strCsvFile As String
Dim f As Object
Set f = Application.FileDialog(3)
f.Filters.Clear
f.Filters.Add "Csv file", "*.csv"
If f.Show = False Then
' no file selected - quite
Exit Sub
End If
Dim strFromTable As String
strFromTable = f.SelectedItems(1)
Dim strTable As String
' get only name of file without extension for Access table name
strTable = Mid(strFromTable, InStrRev(strFromTable, "\") + 1)
strTable = Left(strTable, InStr(strTable, ".") - 1)
strTable = InputBox("Select table = " & strFromTable, "Inport to Access table", strTable)
If strTable = "" Then
' user hit cancel - exit
Exit Sub
End If
' transfer the table into access
DoCmd.TransferText acImportDelim, , strTable, strFromTable, True
' ok, now ask for table name to export to in SQLite
Dim strSQLiteTable As String
strSQLiteTable = strTable
strSQLiteTable = InputBox("Table name to export for SQLite", "SQL lite table name", strSQLiteTable)
If strSQLiteTable = "" Then
' user cancel - don't transfer - exit
Exit Sub
End If
' now transfer table to SQL site
Dim strCon As String
strCon = CurrentDb.TableDefs("Hotels").Connect
' (replace above Hotels with a KNOWN WORKING LINKED table to SQLite)
DoCmd.TransferDatabase acExport, "ODBC Database", strCon, acTable, strTable, strSQLiteTable
MsgBox "table exported to SQLITE"
End Sub
I have VBA for a form.
I'm trying to take the information in a textbox on the form and update a particular field in a table. (haven't figured out how to do that properly)
This line of code is my current try but I'm getting unexpected behavior
The program doesn't continue executing after this
If (Not IsNull([New_Value_Box].Value)) Then
DoCmd.RunSQL "Update [Export_NDC_Certification] Set " & [Field_List].Value & " = " & [New_Value_Box].Value & " WHERE SellerLoanIdentifier = " & Current_Loan
End If
it does however open an input box with the value of Current_Loan as the caption. It doesn't appear to do anything with the input and it doesn't execute any further code. I've used MsgBox's for debugging and its definitely coming from this line. This line was what I came across for taking a value and updating a particular table value with it. if this isn't the way to do it any push in the right direction would be appreciated. Thank you!
First, I would recommend using the Execute method (of either DAO.Database or DAO.QueryDef), instead of using DoCmd.RunSQL. This makes debugging a lot easier (here's a forum post with more information).
Also, since it seems that you need values in all your controls ([Field_List], [New_Value_Box], and Current_Loan), you should do a null check on all of those.
As noted by #HansUp, your actual SQL string is likely causing the issue, so you probably want to store that in a separate variable you can then output to the immediate window.
With all that being said, revised code might look something like this:
Dim db As DAO.Database, qdf As DAO.QueryDef
Dim strSQL As String
If _
IsNull([New_Value_Box].value) Or _
IsNull([Field_List].value) Or _
IsNull([Current_Loan].value) _
Then
' handle missing input
Else
' we know all required fields have values, so can proceed
strSQL = _
"UPDATE [Export_NDC_Certification " & _
"SET " & [Field_List].value & "=" & [New_Value_Box].value & " " & _
"WHERE SellerLoanIdentifier=" & Current_Loan
Debug.Print strSQL
Set db = CurrentDb
Set qdf = db.CreateQueryDef("")
qdf.SQL = strSQL
qdf.Execute dbFailOnError
End If
' clean up DAO objects
Set qdf = Nothing: Set qdf = Nothing: Set db = Nothing
I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function
I have actually this little function working as supposed:
Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
On Error GoTo CreateAttachedError
Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database
DoCmd.SetWarnings False
Set myDB = CurrentDb
Set tdf = myDB.CreateTableDef(strTable)
With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With
myDB.TableDefs.Append tdf
myDB.TableDefs.Refresh
fRetval = True
DoCmd.SetWarnings True
CreateAttachedExit:
createAttached = fRetval
Exit Function
CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
Else
If Err = 3012 Then
Set tdf = myDB.TableDefs(strTable)
tdf.Connect = ";DATABASE=" & strPath
tdf.RefreshLink
fRetval = True
GoTo CreateAttachedExit
End If
End If
End If
End Function
This code works fine, I can call the function as many times as I want to add links to tables from another database. However, I have about 30 tables to import from the same database and this script restarts from scratch everytime I call it. Because the database is located on another server, it takes about 1 min to link the 30 tables.
Is there anything I could do with that function to make it work faster when I need to link multiple tables from the same database? I would like it to work with multiple strTable and strBaseTable in parameters instead of one (maybe arrays?), but I don't know how to do this.
Thank you.
You can loop through the tabledefs collection in the external database or use a table of tables that lists all the tables to be connected and the external database.
Dim db As Database
Dim ThisDb As Database
Set ThisDb = CurrentDB
sDb = "z:\docs\test.accdb"
Set db = OpenDatabase(sDb)
For Each tdf In db.TableDefs
''Connect
If Left(tdf.Name, 4) <> "MSys" Then
If IsNull(DlookUp("Name","MsysObjects","Type In (1,4,5,6) And Name='" _
& tdf.Name & "'")) Then
DoCmd.TransferDatabase acLink, "Microsoft Access", _
sDb, acTable, tdf.Name, tdf.Name
Else
If ThisDb.TableDefs(tdf.Name).connect <> vbNullString Then
ThisDb.TableDefs(tdf.Name).connect = ";DATABASE=" & sDb
ThisDb.TableDefs(tdf.Name).RefreshLink
End If
End If
End If
Next
A table of tables would work in a similar fashion in that you can select the database (select distinct) from the table and loop through that recordset attaching the tables in a further selection (select table where database ...)
What you could also do is set up the database connect in a different sub as well as the database disconnect (which I might be missing here?).
So then the code that calls this script normally (I assume you have a loop) will look like this:
call function/sub that opens the connection to DATABASE= strPath
your loop that calls Function createAttached
call function/sub that closes the connection to DATABASE= strPath
That way you avoid the repetitive (usually time consuming) connection to the external database