Error when transferring table via VBA in Access - ms-access

When I run this, I get run time error 3027: "Cannot update. Database or object is read-only."
Private Sub Export_Run()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "Export_tbl", fd.SelectedItems(1), False
End If
End If
End Sub
The table I'm trying to export (Export_tbl) exists and is editable (not read only), and I can manually export it without issue. I'm guessing this may be an issue with the machine I'm on, with permissions or something? Or am I using the filedialog reference incorrectly? Thanks for any help.

The problem was that I failed to properly assign a full file name for the table being exported---you need to include the file path, name, AND extension (at least in this case, since I'm trying to export as text/CSV). The following worked:
Private Sub Export_Run()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
thename = fd.SelectedItems(1) & ".csv"
DoCmd.TransferText acExportDelim, , "Export_tbl", thename, False
End If
End If
End Sub

Related

Export all tables to txt files with export specification

I have a Access DB containing several different tables, each with a different structure (number & names of fields, number of rows, title).
What I would like to do is to export all these tables into txt files, with a given separator ("|"), point as decimal separator, quotes for strings.
I have browsed the internet and what I got was:
use DoCmd.TransferText acExportDelim command
save a customized export specification and apply it
I get an error messagge ("object does not exist") and I think it is related to the fact that the export specification is "sheet-specific", i.e. does not apply to tables with different fields and fieldnames.
Can you help me?
thanks!!
EDIT.
I post also the original code I run. As I said before, I am new to VBA, so I just looked for a code on the web, adapted it to my needs, and run.
Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim db As DAO.Database
Dim td As TableDef
Dim sExportLocation As String
Dim a As Long
Set db = CurrentDb()
sExportLocation = "C:\" 'Do not forget the closing back slash! ie: C:\Temp\
For a = 0 To db.TableDefs.Count - 1
If Not (db.TableDefs(a).Name Like "MSys*") Then
DoCmd.TransferText acExportDelim, "Export_specs", db.TableDefs(a).Name, sExportLocation & db.TableDefs(a).Name & ".txt", True
End If
Next a
Set db = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Before running the code, I manually exported the first table saving the Export_specs to a file.
Consider a db with two tables, A and B.
When I run the code A is properly exported, then I get the following errore message "3011 - The Microsoft Access database engine could not find the object 'B#txt'. Make sure the object exists and that you spell its name and the path name correctly. If 'B#txt' is not a local object, check your network connection or contact the server administration".
So, it's kind of complex. I've created a routine that imports files using ImportExport Specs, you should be able to easily adapt to your purpose. The basic operation is to create a spec that does exactly what you want to one file. Then, export this spec using this code:
Public Function SaveSpecAsXMltoTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Set oFSO = New FileSystemObject
Set oTS = oFSO.CreateTextFile("C:\Temp\" & sSpecName & ".xml", True)
oTS.Write CurrentProject.ImportExportSpecifications(sSpecName).XML
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Then open this file in Notepad and replace the file name with some placeholder (I used "FILE_PATH_AND_NAME" in this sample). Then, import back into database using this code:
Public Function SaveSpecFromXMLinTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Dim sSpecXML As String
Dim oSpec As ImportExportSpecification
Set oFSO = New FileSystemObject
Set oTS = oFSO.OpenTextFile("C:\Temp\" & sSpecName & ".xml", ForReading)
sSpecXML = oTS.ReadAll
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = sSpecName Then oSpec.Delete
Next oSpec
Set oSpec = CurrentProject.ImportExportSpecifications.Add(sSpecName, sSpecXML)
Set oSpec = Nothing
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Now you can cycle thru the files and replace the placeholder in the spec with the filename then execute it using this code:
Public Function ImportFileUsingSpecification(sSpecName As String, sFile As String) As Boolean
Dim oSpec As ImportExportSpecification
Dim sSpecXML As String
Dim bReturn As Boolean
'initialize return variable as bad until function completes
bReturn = False
'export data using saved Spec
' first make sure no temp spec left by accident
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = "Temp" Then oSpec.Delete
Next oSpec
sSpecXML = CurrentProject.ImportExportSpecifications(sSpecName).XML
If Not Len(sSpecXML) = 0 Then
sSpecXML = Replace(sSpecXML, "FILE_PATH_AND_NAME", sFile)
'now create temp spec to use, get template text and replace file path and name
Set oSpec = CurrentProject.ImportExportSpecifications.Add("Temp", sSpecXML)
oSpec.Execute
bReturn = True
Else
MsgBox "Could not locate correct specification to import that file!", vbCritical, "NOTIFY ADMIN"
GoTo ExitImport
End If
ExitImport:
On Error Resume Next
ImportFileUsingSpecification = bReturn
Set oSpec = Nothing
Exit Function
End Function
Obviously you'll need to find the table name in the spec XML and use a placeholder on it as well. Let me know if you can't get it to work and i'll update for export.

MS Access importing UTF-8 file

I import several '|' separated files to my DB with this:
Private Sub cmdImport_Click()
Dim i As Integer
Dim path1 As String
path1 = "C:\ImportFiles"
Destination = "C:\ImportFiles\processed"
Set fs = Application.FileSearch
With fs
.LookIn = Path1
.FileName = "*.*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
DoCmd.TransferText acImportDelim, "ImportRPS", "tbImportRPSTemp", .FoundFiles(i), False
fileName = .FoundFiles(i)
fileName = Replace(fileName, path1, "")
Set fs1 = CreateObject("Scripting.FileSystemObject")
fs1.MoveFile Path1 & fileName, Destination & Format(Now, "YYYYDDMMTHHMMSS") & fileName
Next i
Else
MsgBox "No files to update", vbInformation
Exit Sub
End If
End With
Me.Requery
End Sub
Problem is, the files are in UTF-8 while the access database I'm working with is not, it imports with '' in front of the first record and my table ends looking like this:
Type Nmbr Date
100 12312 15082013
What can I do to import the files whitout problem? Is it possible to convert the file to ANSI and them import it or are there better ways? I can't do it manually because those files are supposed to arrive by the dozens every day.
According to http://msdn.microsoft.com/en-us/library/office/ff835958.aspx the last parameter of TransferText is the code page. In windows UTF-8 is code page 65001.
So, try adding , , 65001 to your DoCmd.TransferText line. I think it should look like:
DoCmd.TransferText acImportDelim, "ImportRPS", "tbImportRPSTemp", .FoundFiles(i), False, , 650001
I don't have the ability to test this code right now, but I believe it should work.

How to see who is using my Access database over the network?

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

MS Access VBA Export Query results

I need help coming up with a method to allow a user to export a query's results to an xls file on a button click event.
I've tried using an Output To macro, but it doesn't work for a query containing 30,000+ records.
Thanks in advance
You might want to consider using Automation to create an Excel spreadsheet and populate it on your own rather than using a macro.
Here's a function I have used in the past to do just that.
Public Function ExportToExcel(FileToCreate As String, ByRef rst As ADODB.Recordset)
'Parms: FileToCreate - Full path and file name to Excel spreadsheet to create
' rst - Populated ADO recordset to export
On Error GoTo Err_Handler
Dim objExcel As Object
Dim objBook As Object
Dim objSheet As Object
'Create a new excel workbook; use late binding to prevent issues with different versions of Excel being
'installed on dev machine vs user machine
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
'Hide the workbook temporarily from the user
objExcel.Visible = False
objBook.SaveAs (FileToCreate)
'Remove Worksheets so we're left with just one in the Workbook for starters
Do Until objBook.Worksheets.Count = 1
Set objSheet = objBook.Worksheets(objBook.Worksheets.Count - 1)
objSheet.Delete
Loop
Set objSheet = objBook.Worksheets(1)
rst.MoveFirst
'Use CopyFromRecordset method as this is faster than writing data one row at a time
objSheet.Range("A1").CopyFromRecordset rst
'The UsedRange.Rows.Count property can be used to identify the last row of actual data in the spreadsheet
'This is sometimes useful if you need to add a summary row or otherwise manipulate the data
'Dim lngUsedRange As Long
'lngUsedRange = objSheet.UsedRange.Rows.Count
'Save the spreadsheet
objBook.Save
objExcel.Visible = True
ExportToExcel = True
Err_Handler:
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Can you use VBA?
Intellisense will help you, but get started with:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_name", "C:\myfilename.xls"
Note: you may have a different Excel version
"my_query_name" is the name of your query or table
you'll need to set the file location to the appropriate location\name .extension
More Info: http://msdn.microsoft.com/en-us/library/bb214134.aspx

create databases in ms-access, then delete a particular database. using any vb query or vb code

i want to create a number of databases in ms-access using a code or any option of ms-access, but i want delete databases also.
Please help me
You could have an empty database named "db1.mdb", and then add this code inside a module in another Access database:
Set fso = CreateObject("scripting.filesystemobject")
fso.CopyFile "c:\db.mdb", "c:\db_copy1.mdb", True
fso.CopyFile "c:\db.mdb", "c:\db_copy2.mdb", True
fso.CopyFile "c:\db.mdb", "c:\db_copy3.mdb", True
fso.DeleteFile "c:\db.mdb"
To create an Access database from Access interface:
createDatabase "myNewMDB.mdb", dbLangGeneral
To delete a database:
kill "myNewMDB.mdb"
It works without initial mdb file or extra dlls
for multiple databases
public Function createDeleteDatabase(howManyDatabases as integer) as boolean
''output is by default False
createDeleteDatabase = False
on error goto createDeleteDatabase_Error
Dim i as integer
For i = 1 to howManyDatabases
createDatabase "myMDBNumber_" & str(i,0) & ".mdb", dbLangGeneral
Next i
For i = 1 to howManyDatabases
kill "myMDBNumber_" & str(i,0) & ".mdb"
Next i
''if no errors in the fonction, set the output to True
createDeleteDatabase = True
Exit function
createDeleteDatabase_Error:
'' your error treatment
End function