In MS Access I need to back up all queries to a text file
Im able to do this with other Access objects fine, for example the following is a sample that backs up all reports to a text file
Dim oApplication
Set oApplication = CreateObject("Access.Application")
For Each myObj In oApplication.CurrentProject.AllReports
WScript.Echo "Report " & myObj.fullname
oApplication.SaveAsText acReport, myObj.fullname, sExportpath & "\" & myObj.fullname & ".report"
Next
Ive tried the following to backup all queries
For Each myObj In oApplication.CurrentData.AllQueries
WScript.Echo "Query " & myObj.fullname
oApplication.SaveAsText acQuery, myObj.Name, sExportpath & "\" & myObj.Name & ".query"
Next
However the resulting text file is the query output. Its definitely not the Query Definition that Im looking for.
To be clear here is an image of what Im trying to export to text
Does anyone have any ideas on how that can be accomplished?
Iterating through the QueryDefs should work for you
Dim def As DAO.QueryDef
Dim defCol As DAO.QueryDefs
Set defCol = CurrentDb.QueryDefs
For Each def In defCol
Debug.Print def.SQL
Next
How about this (requires 'Microsoft Scripting Runtime' checked under Tools|References in the VBA editor):
Dim Def As DAO.QueryDef
Def FSO As New Scripting.FileSystemObject, Stream As Scripting.TextStream
For Each Def In CurrentDb.QueryDefs
Set Stream = FSO.CreateTextFile(sExportpath & "\" & Def.Name & ".query")
Stream.Write(Def.SQL)
Stream.Close
Next
Alternatively, if you're using VBScript:
Dim Def, FSO, Stream
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Def In oApplication.CurrentDb.QueryDefs
Set Stream = FSO.CreateTextFile(sExportpath & "\" & Def.Name & ".query")
Stream.Write(Def.SQL)
Stream.Close
Next
The value of the acQuery constant is 1. (AcObjectType Enumeration)
Perhaps your results are because the code is using 6 instead of 1. I don't know what should happen in that situation because none of the AcObjectType constants have a value of 6. Using Access VBA, when I tried SaveAsText with 6, something strange happened: the output file was created but Windows denied me permission to view its contents; shortly later, a dialog box appeared which looked like Access was looking for something on SQL Server ... although the query definition I was saving does not involve SQL Server. Strange stuff!
Related
My macro for Word highlights specific words from a specified list for each document in a folder. At the end of the macro, I would like to append the names of each of these files to include "_Highlight" using the command line. I am not too familiar with using the Command Prompt in VBA, so my code ended up being messy.
I am trying to replicate the following command prompt in VBA.
for %a in (“C:\path\*.docx*”) do ren “%~a” “%~Na_Highlight%~Xa”
For the actual file path, I select a folder in FileDialog and store it in a variable to be used in the command prompt, strShellFldr. I am having some trouble concatenating all pieces of the code, especially with special characters, spaces, and quotation literals.
Here is what I tried:
The code below runs just fine, however it seems quite cumbersome. Is there a more efficient way to write this?
Shell.Run "cmd.exe /c" & "for %a in" & Chr(32) & "(" & Chr(34) & strShellFldr & Chr(34) & ")" & Chr(32) & "do ren" & Chr(32) & Chr(34) & "%~a" & Chr(34) & Chr(32) & Chr(34) & "%~Na_Hilight%~Xa" & Chr(34)
Is there a native VBA function that allows you to append a file name maybe?
Thank you for your help and my apologies for posting some wretched code on here.
This piece of VBA code can loop through a list of files in a given folder as input, and add "_Highlight" at the end of the name, just before the file extension:
example:
MyFile.txt --> MyFile_Hightlight.txt
Public Sub RenameFiles(Folder As String)
Dim oFSO As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim ext As String
Dim Name As String
On Error GoTo ERROR_TRAP
Set oFSO = New Scripting.FileSystemObject
Set oFolder = oFSO.GetFolder(Folder)
For Each oFile In oFolder.Files
ext = Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))
Name = Left$(oFile.Path, Len(oFile.Path) - Len(ext) - 1)
oFSO.MoveFile Name & "." & ext, Name & "_Highlight" & "." & ext
Next oFile
Set oFSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing
Exit Sub
ERROR_TRAP:
Debug.Print "ERROR : RenameFiles (" & oFolder.Name & ")"
End Sub
Do not forget to add Microsoft Scripting Runtime reference first in your VB Editor.
I came accross this this post: https://www.access-programmers.co.uk/forums/threads/qrcode-image-generator.299675/
I have tried to copy and edit the VBA code and more into my own access file but it comes with error.
Edited:
To generate an offline QR code in Access, I keep getting this error.
It happens on load and unload form.
I am trying to implement the QR code generator into my own access program.
This is the onLoad code: it's the exact same and all paths are still the same.
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim fld As DAO.Field2
Dim strExcel As String
strExcel = CurrentProject.Path & "\QRCode.xlsm"
If Dir(strExcel) = "" Then
Set rsParent = CurrentDb.OpenRecordset("tblQRSheet", dbOpenDynaset)
rsParent.MoveFirst
Set rsChild = rsParent.Fields("attachment").Value
Set fld = rsChild.Fields("FileData")
fld.SaveToFile strExcel
Set fld = Nothing
rsChild.Close
rsParent.Close
Set rsChild = Nothing
Set rsParent = Nothing
End If
If Dir(CurrentProject.Path & "\QRCodeImages", vbDirectory) = "" Then
MkDir CurrentProject.Path & "\QRCodeImages"
End If
Set gxlApp = CreateObject("Excel.Application")
Set gxlWB = gxlApp.Workbooks.Open(CurrentProject.Path & "\QRCode.xlsm", False, False)
If anyone has any ideas or can help me make this QR code generator work in my own file that would be great. I think that it has to do with the Form's Record Source.
That error implies that you are using types (classes) that are not defined. You have to add the references for it to work. Probably the DAO reference is missing in your project. Go to Tools->References and select "Microsoft DAO 3.6 Object Library". Also the "Microsoft Excel Object Library" might be needed, even if the sample code uses an Object to create the Excel application.
In case this works but you still cannot generate QR codes, consider using an external executable that does just that, and call it using something like:
Dim strCmd As String : strCmd = """" & CurrentDBDir() & "\qrcode.exe"" -o " & """" & myFile & """" & " -s 10 -l H " & """" & strCode & """"
ShellWait strCmd
Where ShellWait is the utility created by Terry Kreft
In MS Access, using VBA, I need to list all actions in a macro, so that I can see what dependencies that macro has: what queries or additional macros it launches.
With the following query I can retrieve a list of all the macros in a database:
SELECT Name, Type, DateCreate, DateUpdate FROM MsysObjects
WHERE (Name Not Like '~*') And (Name Not Like 'MSys*')
And Type=-32766
ORDER BY Name;
Is there anything like a 'MacroDef' object, similar to TableDef or QueryDef, that could provide further details of a macro?
Might there be any profane hidden system table which stored the list of actions in a macro?
Thanks a lot for any tip or guidance to move forward on this.
You may have some luck using the undocumented .SaveAsText method to output the information to a text file, and then read these text files back in using VBA. Try something like:
Sub sExportObjects()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim cnt As Container
Dim doc As Document
Dim strFolder As String
strFolder = "J:\downloads\test\"
Set db = DBEngine(0)(0)
Set cnt = db.Containers("Scripts")
For Each doc In cnt.Documents
Application.SaveAsText acMacro, doc.name, strFolder & "macro_" & doc.name & ".txt"
Next doc
sExit:
On Error Resume Next
Set cnt = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sExportObjects", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Regards,
I have a very large table in MS Access which exceeds the amount of lines Excel can hold. Due to licensing issues, we cannot use access as an external data source, we can, however use Excel to store the tables until we can use SQL Server which is coming in several months.
I have been tasked with breaking up the table into countries.
Getting a query for getting all the distinct countries is no problem.
Select distinct Country_Code
from AllCountries
But then I need to get a result set for each country.
I've been to several sites trying to figure this out before coming here.
I know it's a basic question, unfortunately, a stroke and 10 years away from the field has left me rusty.
I need to create these smaller tables 0r result sets and export them. I'm lost on this one.
Something like this?
PUBLIC FUNCTION exportFiles() AS Boolean
Dim db AS DAO.DATABASE
Dim qdf AS DAO.QueryDef
Dim rsRptGroup AS DAO.Recordset
Dim sSQL AS String
Dim sRptGroup AS String
Dim sPath AS String
Const sQryExport AS String = "qryExport"
sPath = Application.CurrentProject.PATH
SET db = CurrentDb
SET qdf = db.CreateQueryDef(sQryExport, sSQL)
qdf.NAME = sQryExport
' Get list of labeler values
sSQL = "SELECT DISTINCT labeler FROM qry_export"
Set rsRptGroup = db.OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
' Now LOOP THROUGH list OF labeler VALUES AND CREATE a QUERY FOR EACH labeler
' so that the data can be exported
Do While Not rsRptGroup.EOF
sRptGroup = rsRptGroup("labeler")
sSQL = "SELECT * FROM qry_export WHERE labeler = '" & sRptGroup & "'"
qdf.sql = sSQL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, sQryExport, sPath & "\xls\" & sRptGroup & ".xls"
rsRptGroup.MoveNext
Loop
rsRptGroup.Close
Set rsRptGroup = Nothing
db.Close
Set db = Nothing
exportFiles = True
End Function
Reconsider your setup as your claim is not entirely correct:
Due to licensing issues, we cannot use access as an external data
source
MS Access .mdb/.accdb files can be used by any PC machine regardless of the MSAccess.exe program which does require licensing. The underlying technology of MS Access is the JET/ACE SQL Engine which is a set of Windows .dll files, usually pre-installed on PC machines. Access is just a GUI that uses this engine by default.
So continue to use an actual relational database (.mdb/.accdb) files and not flatfile Excel worksheets for data storage and integrity. On machines without Access, files will show up with blank icons unable to be opened directly with any one program but can be connected with Excel or other langauges (PHP, R, Python, Java) via ODBC/OLEDB connections or COM objects --ADO or DAO. In fact, Windows computers can create .mdb/.accdb files without the full fledged Access program. Below are Excel macros for illustration:
CREATE DATABASE (with DAO)
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Access\Database.accdb"
' CREATE DATABASE
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description
Exit Sub
End Sub
CREATE TABLES (with ADO)
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Access\Database.accdb"
' CONNECT TO DATABASE
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description
Exit Sub
End Sub
Additionally, if you require a GUI application of MS Access with forms, reports, macros, and modules, only one person (developer) needs to have the full fledged MS Access to make design changes to database. Meanwhile, all others (users) can use free Runtime versions available for download via Microsoft.com: 2007 / 2010 / 2013 / 2016. Just be sure to have database run without need of a Navigation Pane (i.e., Main Menu navigation).
I am having problems with some code that is supposed to take the results of an Access query and place it in an Excel spreadsheet. I am trying to do this from an Excel VBA module. Here is the code I have so far.
Sub dbopen()
Dim objAccess As Object
Dim db, qr, wb As String
Dim WSS As Worksheet
Set WSS = ActiveSheet
Set objAccess = CreateObject("Access.Application")
db = "C:\Program Files\BWCApps\Databases\DEP\DEP SQL.mdb"
qr = "Active List of Doctors No Duplicates"
wb = "TEMP UNZIP\DEP List of Doctors " & Format(Date, "mm-dd-yyyy") & ".xls"
' Get results of Active List query and put in Excel worksheet
If Not objAccess Is Nothing Then
With objAccess
.OpenCurrentDatabase db
.docmd.OpenQuery qr
.docmd.OutputTo acOutputQuery, qr, acFormatXLS, "C:\Users\A78853\Desktop\" & wb, True
.CloseCurrentDatabase
.Quit
End With
End If
End Sub
The code actually puts the results into the worksheet but then hangs without stopping. When I force a stop I get the following error message.
"Run-time error '-2147023170 (800706be)':
Automation error
The remote procedure call failed."
I'm at a complete loss as to what is happening here, so any help would be greatly appreciated! Thank you!
See Remou's comment first and see if that helps. If you get completely stuck and decide to start from Access and export to Excel:
Here is some sample code to export a query from Access VBA to Excel:
Dim outputFileName As String
outputFileName = CurrentProject.Path & "\WhereYouWantItExported" & Format(Date, "yyyyMMdd") & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "YourQueryName", outputFileName, True
MsgBox "Data exported to " & CurrentProject.Path & "\Reports\WhereYouWantIt_" & Format(Date, "yyyyMMdd") & ".xlsx"
You should be able to add this to an On Click handler or something and export what you need. Of course, this is for Access to Excel, not Excel to Access back to Excel.
In case you needed it, here it is. I realize this doesn't exactly answer your question because the process originates in Access and not Excel.