Frequently I drop ready-made queries into Access. Create > Query Design > SQL, and paste the code directly to the text window.
Generally I do not save these queries in Access because I have to minimize the clutter of one-time, ad hoc reporting. I wrote a macro for Access that will automatically save the results of an established query...
Sub qry40T_export()
'export the results of the query "qry40T" to local excel file
'prompt the user for the save location
'name the file "qry40T_output.xls"
'initialize variable type
Dim save_dir As String
save_dir = "dunno_yet"
'initialize default filename
savefile_name = "qry40T_output.xls"
'prompt user for save location
save_dir = InputBox(Prompt:="Save query export to the following directory:", Title:="Save file to:", _
Default:="F:\QUERYDATA\")
'validate user submitted
If save_dir = "" Then
'user chose 'Cancel'
Exit Sub
End If
'compose full save filename
fullsavefile_name = save_dir & savefile_name
'edit error treatment
On Error GoTo ErrHandler
'export the query
'overwrite "qry40T_output.xls"
DoCmd.OutputTo acOutputQuery, "qry40T", "Excel97-Excel2003Workbook(*.xls)", fullsavefile_name, False, "", , acExportQualityPrint
'success
MsgBox ("Export successful.")
'restore error treatment
On Error GoTo 0
'error handling resolution
subexit:
Exit Sub
'error handling message
ErrHandler:
MsgBox Error$
Resume subexit
End Sub
...but now I would like to apply this same process to an unsaved query. Is that possible? My guess is that the code would look something like this: DoCmd.OutputTo acOutputQuery, OpenQuery(1), "Excel97-Excel2003Workbook(*.xls)", fullsavefile_name, False, "", , acExportQualityPrint, but I can't seem to find the right syntax.
Since these are 'throw-away' queries and don't need to be saved, you could save them with the same query name every time.
For example, you can always save your temporary queries as "qry40T". Then, your macro will always work and save the results of whatever query is saved in qry40T at the time.
Related
I used the code provided by Siddharth Rout in the following threat.
Detect whether Excel workbook is already open
My goal was to check if a certain named workbook was open and depending on the result perform certain actions.
This was the result.
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
The following piece refers back to the function and depending on the result performs certain actions.
Dim xls As Object
Dim Answer As String
Dim Mynote As String
If IsWorkBookOpen(Environ("USERPROFILE") & "\Desktop\Report.xlsm") =
True Then
Mynote = "The Report is still open. Do you want to save the Report ?"
Answer = MsgBox(Mynote, vbQuestion + vbYesNo, "Warning Report open")
If Answer = vbYes Then
MsgBox "Please Save your Report under a new name and close it. then press update again"
Exit Sub
Else
Set xls = GetObject(Environ("USERPROFILE") & "\Desktop\Report.xlsm")
xls.Close True
End If
Else
End If
This used to work perfectly in the past but since today it suddenly gives me error 53.
While trying to resolve the issue I discovered the error only occurs when the named workbook is not on the desktop. Strangely enough it did not have this issue in the past. I specifically tested that because the file will not always be on the desktop.
I tried several backups tracking back 2 months and even those show the same error now.
While searching the internet for this issue i found this thread,
Check if excel workbook is open?
where they suggest to change the following pieces,
(ErrNo = Err) in to (Errno = Err.Number)
(ff = FreeFile_()) in to (ff = FreeFile)
I did both together and independitly. eventhough i dont really see the relation between the error and Freefile.
This did not change the error at all.
While I am currious to why this error suddenly occurs I really do need a solution or alternative.
what i need it tot do again is,
- Check if named workbook is open.
- when it is open a Msgbox with yes and no option should appear.
- On "No" it should close the named workbook and continue with whatever is below of what i posted.
- On yes it should pop a message box and stop.
Any help that can be provided will be highly appreciated.
You need to check if the file exists before checking if it is open;
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
' bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long
'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
If bFindFolders Then
lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
'Strip any trailing slash, so Dir does not look inside the folder.
Do While Right$(strFile, 1) = "\"
strFile = Left$(strFile, Len(strFile) - 1)
Loop
End If
'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function
I have set up a basic macro where I export the contents of a table to excel. Macro works great, but now I want to create a check to see if the file name that I am saving to already exists, and if so, deletes that file so that I do not have the user deal with the prompt box asking if they would like to overwrite the file.
I converted the macro to VBA so that I could add in the desired dir(filename) and kill(filename) code. Once completed I was able to successfully run the code in the VBA editor, however, when I tried running the code based on the "on close" event of a form I have in access, it will only run the code as viewed in the access macro structure, as if I never added any additional lines of code in the VBA editor. Is there something that I was supposed to do to convert back from VBA to Access once I completed my edits?
Please see below for code that I would like to execute:
Function ExportLot()
On Error GoTo ExportLot_Err
Dim filename As String
filename = "\\server1\Trial
Database for QS Reports\Lot Log Report.xlsx"
DeleteFile (filename)
DoCmd.OutputTo acOutputQuery, "LLUnion", "ExcelWorkbook(*.xlsx)", filename, False, "", , acExportQualityPrint
ExportLot_Exit:
Exit Function
ExportLot_Err:
MsgBox Error$
Resume ExportLot_Exit
End Function
Function FileExists(ByVal FileToTest As String) As Boolean
FileExists = (Dir(FileToTest) <> "")
End Function
Sub DeleteFile(ByVal FileToDelete As String)
If FileExists(FileToDelete) Then 'See above
' First remove readonly attribute, if set
SetAttr FileToDelete, vbNormal
' Then delete the file
Kill FileToDelete
End If
End Sub
Original converted code (what currently runs when I call ExportLot from the form):
Function ExportLot()
On Error GoTo ExportLot_Err
Dim filename As String
DoCmd.OutputTo acOutputQuery, "LLUnion", "ExcelWorkbook(*.xlsx)","\\server1\Trial Database for QS Reports\Lot Log Report.xlsx", False,"", , acExportQualityPrint
ExportLot_Exit:
Exit Function
ExportLot_Err:
MsgBox Error$
Resume ExportLot_Exit
End Function
I managed to figure out either the solution to or a work around for this problem. I created a new macro (ExecuteCloseCode), and used the RunCode Event to call my function (ExportLot()) as defined in the question.
Then I used the on close event to call the "ExecuteCloseCode".
I am not sure why this method worked and my previously proposed efforts did not...
I created code for importing data from Excel into desired table, via TransferSheet and builded Query method. I'm also trying to resolve all errors that User could do when Importing data into db (wrong file format, appending 0 rows,field names not same as in DB etc.), but cannot get rid of Error 3059 "was unable to append all data to table" - It occurs when you try to Import some invalid data. I want a custom Msgbox for this error, and stop executing my Query. Here's my code - in short :
Private Sub CmdImport_Click()
Dim SQL As String
Dim dbs As DAO.Database
Set dbs = CurrentDb
On Error GoTo ERR1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "NEWTABLE", "<Imported file>", True
SQL = " INSERT INTO MyTable (Field1)" & _
" SELECT DISTINCT" & _
" FROM NEWTABLE"
DoCmd.SetWarnings False
dbs.Execute SQL
DoCmd.RunSQL "DELETE * FROM NEWTABLE"
DoCmd.SetWarnings True
ERR1:
If Err.Number = 3059 Then
MsgBox "This file doesn't have proper data to import. Import canceled !"
Exit Sub
End If
End Sub
This code pops-up custom Msgbox after Access allready opens built-in window, regardless of DoCmd.SetWarnings False. If I move DoCmd.SetWarnings False before TransferSheet method, import gets executed and no Msgbox is displayed - which is wrong. How can I handle this error, anybody knows ??
You could import to a temp table.
Then read this with a query that converts and cleans the data, and use this query for your further processing - which now will run without errors caused by malformed data.
I have figured out another way to solve this. I have put all controls that I need before DoCmd.TransferSheet method, including eliminating error that causes "was unable to append all data to table". I added code for checking excel file, and If Excel file data doesn't match criteria, DoCmd.TransferSheet is not performed - so therefore error "was unable to append all data to table" doesn't appear at all. Here It is (part of code which first checks If Excel file data is proper to perform DoCmd.TransferSheet import) :
Dim XcelApp As Object
Dim x, i
Set XcelApp = CreateObject("Excel.Application")
XcelApp.ScreenUpdating = False
XcelApp.Workbooks.Open("C:\Users\Lucky\Desktop\Test\Sample.xlsx")
With XcelApp
i = XcelApp.Rows(1).Find(What:="Število", LookIn:=xlValues, Lookat:=xlWhole).Column
x = XcelApp.Range(XcelApp.Cells(1, i), XcelApp.Cells(XcelApp.Rows.Count, i).End(xlUp)).Value
For i = 2 To UBound(x)
If Not IsNumeric(x(i, 1)) Then
ExcelApp.Quit
Set ExcelApp = Nothing
MsgBox "This Excel file is not valid"
: Exit Sub
End If
Next i
End With
XcelApp.Quit
XcelApp = Nothing
Code is snapshop from this solved thread: loop through Excel columns
I have a function that has been in use for a number of months that checks to see if the form that is going to be opened will actually have records to be viewed before opening it. Recently I decided to change from ACCDB to ACCDE for security purposes. After making the change over the function started throwing error 2450 "Microsoft Access cannot find the referenced form..." I can't seem to find anything of use online that could tell me what the cause of this error is and why it only happens with ACCDE.
On a side note I realize the inefficiency of the logic in this function, it's on my list.
Public Function ValidateFormToOpen(strFormName As String, strFilter As String, strFieldName As String) As Boolean
On Error GoTo Err_Handler
Dim intNumberOfRecords As Integer
'If the form is currently open count how many results will be shown
If CheckFormState(strFormName) Then
intNumberOfRecords = DCount(strFieldName, Access.Forms(strFormName).RecordSource, strFilter)
'If it is closed open it in a hidden state and then count how many records would be shown
Else
DoCmd.OpenForm strFormName, acDesign, "", strFilter, , acHidden
intNumberOfRecords = DCount(strFieldName, Access.Forms(strFormName).RecordSource, strFilter)
DoCmd.Close acForm, strFormName
End If
'If there were records that will be shown return true
If intNumberOfRecords > 0 Then
ValidateFormToOpen = True
Else
ValidateFormToOpen = False
End If
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, strMODULE_NAME & ".ValidateFormToOpen on " & strFormName)
Resume Exit_Handler
End Function
This is the CheckFormState Code
Public Function CheckFormState(sFormName As String) As Boolean
On Error GoTo Err_Handler
If Access.Forms(sFormName).Visible = True Then
CheckFormState = True
End If
Exit_Handler:
Exit Function
Err_Handler:
CheckFormState = False
Resume Exit_Handler
End Function
An ACCDE format database restricts design capabilities in general. I think that may be why you get an error with this line:
DoCmd.OpenForm strFormName, acDesign, "", strFilter, , acHidden
However I'm not positive that is the complete explanation because when I attempt to open a form in Design View (DoCmd.OpenForm "Form1", acDesign) in my ACCDE database, Access gives me a different error message:
"The command you specified is not available in an .mde, .accde, or .ade database."
So I don't know what the solution is for your goal, but I believe it can not be based on opening a form in Design View.
I have designed a system that is used to track customer activity and log calls to a department. The front end and back end database are written in access. This system is due to go to the USA division of the company i work for.
The front end needs to automatically refresh the tables and if the backend database has moved (which it will when i send it to the US) the code will then look at a function to read the location of the new database. Sample of the read text file function code shown below:
Function ReadDbPassword()
'--
' Filetostring(FILEInput$ as variant) ' to make this a callable function
Dim FILEInput As Variant
'--
On Error GoTo FileToString_Error
FILEInput = "C:\Users\Public\databaseUser\PassCon"
Passmyfile = FreeFile
Open FILEInput For Input As Passmyfile
Passthedata4 = Input(LOF(Passmyfile), Passmyfile)
Close Passmyfile
On Error GoTo 0
Exit Function
FileToString_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Function
The text file contains a path like the one below:
P:\Projects\Database.accdb
I have found code that uses a similar idea to what i want and i have been looking at the code on the link below, however i do not fully understand how this code works in order to alter it to what I need to use the read text file.
http:/ /access.mvps.org/access/tables/tbl0009.htm
-------EDIT --------
I have tried to edit the following section to use the read text function
Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String
strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")
fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function
By replacing all the code with
fGetMDBName = Passmyfile
You are mixing apples and oranges in what you are trying to do. Here are my suggestions:
Make sure your module has 'Option Explicit' then compile all your code. I see variables referenced but have no idea what TYPE they are.
Change your Function 'ReadDbPassword()' to return a string variable, then set it to return Passthedata4.
The second Function you listed (fGetMDBName) is opening a File Dialog box to allow you to select a file name. You do not need that since you already will have the file path/name from your first Function.
Then adapt the code you found that does the relink to use the path/name from your subroutine.