I have a problem with my back end data file staying open, LACCDB file stays open. I have narrowed it down to a few lines of code that is causing the problem. I have tried a number of solutions but nothing works for me. The only option is to close the front end but that's not practical.
I want to copy this BE file but cant if the LACCDB file is open. No other users. I have tried deleting both the Query and the table(linked) but that still does not resolve the issue. Running MS Access 2007 and tried on various PC's. I have also tried moving the ACCDB file from Mapped drive to local drive.
The code:
Function TestMyLinks()
MyQuery="Test-Filter"
MyTable="Test"
MyCriteria = "[TestId]> 1"
MyCriteria = "SELECT [" & MyTable & "].*" & " FROM [" & MyTable & "] Where " & MyCriteria
DoCmd.DeleteObject acQuery, MyQuery 'Delete new query.
Set qdf = DataDb.CreateQueryDef(MyQuery, MyCriteria) ' Create new query
DoCmd.Close acQuery, MyQuery, acSaveYesDoCmd.Close acTable, "Test", acSaveYes
' This following code does not make any difference
'DoCmd.DeleteObject acQuery, "Test-Filter"
'DoCmd.DeleteObject acTable, "Test"
'DoCmd.TransferDatabase TransferType:=acLink, _
' DatabaseType:="Microsoft Access", _
' DatabaseName:="C:\MyClock\Test.accdb", _
' ObjectType:=acTable, _
' Source:="Attendance", _
' Destination:="Attendance"
'Application.SetOption "Auto compact", True
'DoCmd.RunCommand acCmdCompactDatabase
'DBEngine.CompactDatabase "C:\MyClock\Test.accdb", "C:\MyClock\TestA.accdb" ' This fails1 as file locked
End Function
I have tried closing the tables using code:
DoCmd.Close acQuery, "Test-Filter", acSaveNo
DoCmd.Close acTable, "Test", acSaveNo
I have also tried as per another post to release memory:
'release memory
qdf.Close 'i changed qdef to qdf here and below
Set qdf = Nothing
Related
I have an MS Access database that creates physician report information. The final report has many pages consisting of all the physicians in my query.
My goal is to take this large report and move physician specific information into a separate folder as a pdf file. The large final report is master linked based on the physicians EPIC_ID. I also have a separate table that has distinct EPIC_ID with physician names (tblPhysicianID_Range). I want to go down the list of physicians from this table, and pull out specific information for each physician, create a pdf file of that information and send it to a folder with that physicians name.
At one point I had this code working just fine, but I had to make some adjustments to the large final report. None of the adjustments affected what links everything together, the EPIC_ID.
Exact error I'm getting:
Run-time error '3071':
This expression is typed incorrectly, or it is too complex to be evaluated. For example, a numeric expression may contain too many complicated elements. Try Simplifying the expression by assigning parts of the expression to variables.
And this is the highlighted debug:
DoCmd.OpenReport "rptCombined", acViewPreview, , _
strRptFilter, acHidden ' open the report hidden in preview mode setting the where parameter
Here is the entire code:
Private Sub Command0_Click()
Dim rst As DAO.Recordset
Dim strFolder1 As String, strFolder2
DoCmd.OpenQuery "qryPhysicianID_Range_tbl"
Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Prov_Order_Name],[EPIC_ID] FROM [tblPhysicianID_Range] ORDER BY [EPIC_ID];", dbOpenSnapshot)
If rst.RecordCount > 0 Then ' make sure that we have data
rst.MoveFirst
Do While Not rst.EOF
strRptFilter = "[EPIC_ID] = " & Chr(34) & rst![EPIC_ID] & Chr(34)
strFolder1 = "U:\Co\Physician\Reappointment\Jordans Test\" 'common folder for files to go
strFolder2 = strFolder1 & rst.Fields("[Prov_Order_Name]") & "\" 'creates folder by Provider Name
If Dir(strFolder2, vbDirectory) = "" Then MkDir strFolder2 'determines if folder exists or not, and if it doesn't it makes one
DoEvents
rst.MoveNext
Loop
End If
If rst.RecordCount > 0 Then ' make sure that we have data
rst.MoveFirst
Do While Not rst.EOF
strRptFilter = "[EPIC_ID] = " & Chr(34) & rst![EPIC_ID] & Chr(34)
strFolder1 = "U:\Co\Physician\Reappointment\Jordans Test\" 'common folder for files to go
DoCmd.OpenReport "rptCombined", acViewPreview, , _
strRptFilter, acHidden ' open the report hidden in preview mode setting the where parameter
DoCmd.OutputTo acOutputReport, "rptCombined", acFormatPDF, _
strFolder1 & rst.Fields("[Prov_Order_Name]") & "\" & rst.Fields("[Prov_Order_Name]") & ".pdf" ' save the opened report
DoCmd.Close acReport, "rptCombined" ' close the report
DoEvents
rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
End Sub
"And this is the highlighted debug: DoCmd.OpenReport "rptCombined", acViewPreview, , _ strRptFilter, acHidden ' open the report hidden in preview mode setting the where parameter"
This is pointing to the report, if the report is based on a select query, check the syntax of the query and ensure the query runs well by returning values.
Second thing you have to look at (this is based on the error message description in your post), the report filter has to be looked into.
if you share the images of the query design view and query SQL view, more clarity will come then, that can aid to a solution.
I was able to figure out the main problem why this wasn't working.
It turns out my "where" statement in the OpenReport section;
strRptFilter = "[EPIC_ID] = " & Chr(34) & rst![EPIC_ID] & Chr(34)
Wasn't working because my subreports weren't linked properly to the correct table [EPIC_ID] that was being used, and in addition, this was initially set up to find physician names, not ID's which are numbers/integer, so I switched the "where" to;
strRptFilter = "[EPIC_ID] = " & rst![EPIC_ID]
and it worked!
I now have a problem though, with having the subreports show their table in the final pdf even when there is no data for that physician, but I will post that as a separate question. Thanks!
i've been struggling around trying to get my VBA to work & i'm at a loss since i'm extremely fresh using VBA or coding in-general.
What i've got is basically a Navigation Main Form that uses tabs to open up different forms for ease of access. On one of these subforms there is a button that is supposed to work as a "SaveAsPDF" option. it's basically supposed to work by opening up a folder you want to save it in, & exporting the Report version as a pdf to the location. The weird thing is that it works perfectly when you have the actual form open & not the form open in the navigation menu, so i'm at a loss now.
If anyone is able to help, it's much appreciated & you'll be saving alot of hair from the floor. What i've got is below
Private Sub SaveAsPDF_Click()
Dim fd As FileDialog
On Error goto ErrorHandler
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialFileName = MAFNO & ".pdf"
End With
If fd.Show Then
DoCmd.OutputTo acOutputReport, "RptMAFPrint", acFormatPDF, _
fd.SelectedItems(1), True
End If
Exit sub
ErrorHandler:
Msgbox "An Error occurred, please try again", vbinformation, "Could not save document"
Exit sub
End Sub
As far as it running on it's own when you open the actual form up, it works perfectly & hasn't had a single error, but when opening it up from the Navigation Menu Tab it immediately has an error & tries to save the entire workbook.
Error below
https://imgur.com/a/rSynDic
Longpast on this post, but Kostas had the answer & I was easily able to edit the vba to make it work. Thank you thank you kostas, if I could actually put yours as the answer, I would.
VBA is below if anyone would ever need it. I'll probably go back at some point & see if I could re-write it better, but it gets the job done for the most part.
This does work perfectly for a MS Access Navigation form though & it does not close the current active tab at the end of the VBA.
Private Sub ButtonSaveAsPDF_Click()
Dim fd As FileDialog
On Error GoTo ErrorHandler
DoCmd.Save
DoCmd.RefreshRecord
'==== Initial Check ====
If IsNull(Me.TxtMAFNumberTop) Then
GoTo Leave
ElseIf Not IsNull(Me.TxtMAFNumberTop) Then
GoTo Start
End If
'==== SaveAs PDF Start ====
Start:
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialFileName = TxtMAFNumberTop & ".pdf"
End With
If fd.Show Then
DoCmd.OpenForm "FrmMAF", acNormal, , "[ID] = " & ID, , acHidden
DoCmd.OutputTo acOutputReport, "RptMAFPrint", acFormatPDF, _
fd.SelectedItems(1), True
DoCmd.Close , "FrmMAF"
End If
Exit Sub
Leave:
Exit Sub
ErrorHandler:
MsgBox "An error occurred trying to print your MAF. Please try the following
below & try again" & vbCrLf & _
vbCrLf & _
"1) Verify current MAF information & fields are correct" & vbCrLf & _
"2) Cycle Records & try again " & vbCrLf & _
vbCrLf & _
"If this problem occurs again please contact your local Administrator", _
vbCritical + vbRetryCancel, _
"[Critical] ERROR : SaveAsPDF "
If vbRetry Then
GoTo Start
ElseIf vbCancel Then
Exit Sub
End If
End Sub
I realise this is probably the simplest question ever but I'm about to tear my hair out.
I am trying to export an access report for a single record in my data table, as specific by the field Unique ID.
I keep getting thrown a run time error occurring in the DoCmd.OpenReport line. For the life of me I cannot figure out where or why this is happening.
In a perfect world, I would want the user to be able to enter as many Unique ID's as they want, and it would export a single report for each line (not a large report containing all rows).
Sub test()
Dim MyFileName As String
Dim rst As DAO.Recordset
Dim strReportName As String ' report name to work with
Dim strOutPutFile As String ' pdf output file on disk
strReportName = "TEST"
Set rst = CurrentDb.OpenRecordset("table")
Do While rst.EOF = False
strOutPutFile = "C:\Users\me\Documents" & "-test1-" & rst![Unique ID] & ".pdf" ' output file = ID.pdf
DoCmd.OpenReport "TEST", acViewPreview , , "Unique ID = " & rst![Unique ID]
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strOutPutFile
DoCmd.Close acReport, strReportName
rst.MoveNext
Loop
rst.Close
MsgBox "done"
End Sub
I'm trying to export all my tables, from my access database, to separate .csv-files. I have a loop that runs through all tables and by using TransferText I want to create a .csv-file for each table.
I am able to create a single file by writing the TransferText method.
DoCmd.TransferText acExportDelim, "ExportCsv", [Table name], filePath + "Test.csv", True
But when I'm trying to create a loop to generate a file for each table I get into trouble. (Filepath is set to desktop)
' Loops through all tables and extracts them as .csv-files
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
' ignore system and temporary tables
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
' Export table as CSV
'MsgBox (tdf.Name)
fileName = tdf.Name & ".csv"
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, filePath + fileName, True
End If
Next
Set tdf = Nothing
Set db = Nothing
Doing it like this gives me Error '3011' saying it can't find the object. Then it gives me the object name: [table name]#csv. So for some reason it changes ".csv" to "#csv".
If I remove the file extension from the file name all I get is Error 3027 saying that the object or database is read-only.
Does anyone know if there is a solution to my problem or another way to do the same thing? Or am I gonna have to go a completely different route?
EDIT:
Other tested variations
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/tempFile.csv", True
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/" & tdf.Name & ".csv", True
: Gives a "#csv" error.
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/tempFile", True
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/" & tdf.Name, True
: Gives a read only error
This is known limitation. TransferText doesn't like convoluted filenames.
So, export to a simple filename, then rename that file to its final name:
ExportFinal = "YourFinalName.csv"
ExportTemp = "FileToRename.csv"
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, ExportTemp, True
VBA.FileCopy ExportTemp, ExportFinal
VBA.Kill ExportTemp
So after lots of trial and error I have found a way that works for me.
With some inspiration from #Gustav I went with creating .xls files, which for some reason works. And then convert those files with a custom script to .csv-files. Then I remove the .xls files leaving only my .csv-files left.
So my loop now looks like this:
For Each tdf In db.TableDefs
' ignore system and temporary tables
If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
' Export as xls-files
fileName = tdf.Name & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, tdf.Name, filePath & env & fileName, True
' Convert xls-files to .csv and remove the xls-files.
ConvertXls2CSV (filePath & env & fileName)
VBA.Kill filePath & env & fileName
End If
Next
And here is the converting code: (Credit to: https://www.devhut.net/2012/05/14/ms-access-vba-convert-excel-xls-to-csv/)
Function ConvertXls2CSV(sXlsFile As String)
On Error Resume Next
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim bExcelOpened As Boolean 'Was Excel already open or not
'Review 'XlFileFormat Enumeration' for more formats
Const xlCSVWindows = 23 'Windows CSV Format
Const xlCSV = 6 'CSV
Const xlCSVMac = 22 'Macintosh CSV
Const xlCSVMSDOS = 24 'MSDOS CSV
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
'On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
'On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden from the user
oExcel.Application.DisplayAlerts = False
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
'Note: you may wish to change the file format constant for another type declared
'above based on your usage/needs in the following line.
oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows, Local:=True
oExcelWrkBk.Close False
If bExcelOpened = False Then
oExcel.Quit
End If
Error_Handler_Exit:
On Error Resume Next
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ConvertXls2CSV" & vbCrLf & _
"Error Table: " & sXlsFile & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
I'm new to Access as well as VB so please bear with me.
I've found and modified a small snip of code to connect to a password protected access db on the network in an attempt to import the table defs and data into a separate database (effectively a copy).
The problem I'm running into is when I execute the code I get a 3043 error and the tables are not imported. This does not happen when I use the GUI import tool through access.
does anyone know why I only receive this error when using the code (executed via macro), and how I might diagnose the issue for myself in the future?
Or perhaps a better way to automate the importing of data? This was the first method that popped in my head after a bit of digging, so if there is a better way to approach this I'm all for learning.
Code snipit for reference (if I'm using bad practices or doing something wrong please point it out):
Public Function ImportAllTbls(sExtDbPath As String, sExtDbName As String, sExtDbPass As String)
On Error GoTo Error_Handler
Dim tdf As DAO.TableDef
Dim acc As Access.Application
Dim db As DAO.Database
Dim fullDbPath As String
fullDbPath = sExtDbPath & "\" & sExtDbName
Set acc = New Access.Application
acc.Visible = True
acc.OpenCurrentDatabase fullDbPath, False, sExtDbPass
Set db = acc.CurrentDb()
For Each tdf In db.TableDefs 'Loop through all the table in the external database
If Left(tdf.Name, 4) <> "MSys" Then 'Exclude System Tables
On Error GoTo Error_Handler
acc.DoCmd.TransferDatabase acImport, "Microsoft Access", fullDbPath + ";pwd=" + sExtDbPass, acTable, tdf.Name, tdf.Name, False, False
End If
Next tdf
db.Close
Set db = Nothing
Exit Function
Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: ImportAllTbls" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Exit Function
End Function
not sure the acc is needed, you might try just:
DoCmd.TransferDatabase acImport, "Microsoft Access", fullDbPath + ";pwd=" + sExtDbPass, acTable, tdf.Name, tdf.Name, False, False
End If
This syntax is very suspect: + ";pwd=" + sExtDbPass
I would suggest you manually type in the path and password; rather than call it - - just as a sanity check to get at least it working..... and then do more research on the correct syntax of your Where statement regarding the PW.