I recently migrated an Access database (that someone more knowledgeable than I designed) to MySQL, and linked the tables back into Access to use as a front end. Almost everything looks great. There is just one form and chunk of VBA code that doesn't seem to work. There is a form that should show drop down menus and controls, but is blank in form view. The form in design view and form view The VBA code that goes with the form is
Option Compare Database
Private Sub cmdPreviewPlate_Click()
'show user the new plate that is to be added to tblPCRsamples
On Error GoTo Err_cmdPreviewPlate_Click
'check whether boxes are blank
Dim bolBlank As Boolean
bolBlank = False
If IsNull(Me.Controls!cboChooseTemplatePlate) Then bolBlank = True
If IsNull(Me.Controls!cboChooseLocus) Then bolBlank = True
If IsNull(Me.Controls!txtEnterDate) Then bolBlank = True
If bolBlank = False Then
'enable the Add button
Me.Controls!cmdAddPlate.Enabled = True
'generate the unique PCRplate from the template plate number and locus
' using the global variable GstrPCRPlateName so that the queries can add the plate name to both tables
GstrPCRPlateName = Me.Controls!cboChooseTemplatePlate.Value & "_" & Me.Controls!cboChooseLocus
'check: does this PCRplate already exist in tblPCRplates?
Dim dbs As Database
Dim rst As Recordset
Dim bolDone As Boolean
Dim bolNameExists As Boolean
bolDone = False
bolNameExists = False
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblPCRplates", dbOpenDynaset)
rst.MoveFirst
Do Until bolDone = True
'does the new plate name automatically generated here = the value of PCRplate in the current record?
If GstrPCRPlateName = rst![PCRPlate] Then
bolNameExists = True
bolDone = True
End If
rst.MoveNext
If rst.EOF Then bolDone = True
Loop
'if the name already exists, make a new name by appending _ and the date
If bolNameExists = True Then
GstrPCRPlateName = GstrPCRPlateName & "_" & Me.Controls!txtEnterDate
End If
'set the value for the Locus
GstrGetLocus = Me.Controls!cboChooseLocus
'open the select query to show user what they're going to add to the PCR plates & samples tables
Dim stDocName As String
stDocName = "qryNewPCR_1SelectTemplatePlate"
DoCmd.OpenQuery stDocName, acNormal, acReadOnly
Else
'if user left fields blank (except page number, that can be blank), show an error message
MsgBox "Choose/enter values for all the boxes"
End If
Exit_cmdPreviewPlate_Click:
Exit Sub
Err_cmdPreviewPlate_Click:
MsgBox Err.Description
Resume Exit_cmdPreviewPlate_Click
End Sub
Private Sub cmdAddPlate_Click()
'add this new plate to tblPCRplates and tblPCRsamples
On Error GoTo Err_cmdAddPlate_Click
'add the new plate to tblPCRplates
Dim stDocName As String
stDocName = "qryNewPCR_2AppendPlate"
DoCmd.OpenQuery stDocName, acNormal, acEdit
'run the query to append the samples to tblPCRsamples
stDocName = "qryNewPCR_3AppendSamples"
DoCmd.OpenQuery stDocName, acNormal, acEdit
'open frmPCRSamples to show the new plate has been added
stDocName = "frmPCRSamples"
DoCmd.OpenForm stDocName, acFormDS
Exit_cmdAddPlate_Click:
Exit Sub
Err_cmdAddPlate_Click:
MsgBox Err.Description
Resume Exit_cmdAddPlate_Click
End Sub
So my question is, should the linked tables be causing errors? Is there something I can amend to say that they are linked? Or am I barking up the wrong tree?
Thanks for your help. I know nothing of VBA (I mean, I can follow along) and have been tasked to destroy, I mean...admin...this database. This is what happens when you give biologists computers ;-) Even just some good resources would help a great deal.
The happens when your RecordSource of the form returns zero records and the form or record source does not allow adding new records.
Check the record source (table, query, or SQL string) and run it manually to see if it returns records.
Related
I have a table (tblForms) in which one of the fields is a lookup to another table (tblClients). How can I find if a certain Client has data or does not have data in tblForms? DCount only works if the Client does appear in tblForms.
I have a form (frmDisclosure) with a command button - onClick:
Private Sub Command245_Click()
On Error GoTo Command245_Click_Err
DoCmd.OpenForm "frmClient", acNormal, "", "[ClientID]= " & Me.Client, , acNormal
DoCmd.Close acForm, "frmDisclosure"
Command245_Click_Exit:
Exit Sub
Command245_Click_Err:
MsgBox Error$
Resume Command245_Click_Exit
End Sub
When I click this I get the error (N.B. I f I open frmClient directly form Switchboard I don't get the error). frmClient has a subform (continuous) frmFormsList which derives its data from:
SELECT tblForms.ClientLookup, tblForms.Issued, First(tblForms.RefNo) AS FirstOfRefNo, Last(tblForms.RefNo) AS LastOfRefNo, Count(tblForms.RefNo) AS CountOfRefNo, tblClient.KnownAs, tblClient.EMail
FROM tblForms INNER JOIN tblClient ON tblForms.ClientLookup = tblClient.ClientID
GROUP BY tblForms.ClientLookup, tblForms.Issued, tblClient.KnownAs, tblClient.EMail
HAVING (((tblForms.Issued) Is Not Null));
This function resides in frmFormsList:
Public Function NumRecs() As Integer
NumRecs = DCount("*", "tblForms", "ClientLookup = " & Me.ClientLookup)
End Function
My query shows data where I have issued forms to a client. Therefore if I have not issued forms to a Client tne the query shows nothing for that client so does not give a result 0. I get RunTime Error 2427 "You entered ans expression that has no value". NumRecs = DCount("*", "tblForms", "ClientLookup = " & Me.ClientLookup) is highlighted in debug.
In frm Disclosure, if I Rem out ", acNormal, "", "[ClientID]= " & Me.Client, , acNormal" the problem does not occur, but I don't get straight to the Client I am interested in. So the problem occurs when I try to open a form using the Rem'd out bit where the client has not been issued with any forms. When I opne the frm Client directly the rocord presented does not have forms issued but the problem does not occur.
Here's the solution:
Public Function NumRecs() As Integer
Dim dbs As DAO.Database
Dim rs As Object
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("qryDisclosure", dbOpenDynaset)
If Me.Recordset.RecordCount = 0 Then
NumRecs = 0
Else
NumRecs = Nz(DCount("*", "qryDisclosure", "ClientLookup = " & Me.ClientLookup), 0)
End If
End Function
I am new to VB Scripting and Scripting of any kind but I am a fast learner.
I have with the help of various aids been developing an Access database where scripting is used.
I have developed the below script as part of a login screen.
Private Sub cmdLogin_Click()
Dim dbs As Database
Dim rstUserPwd As Recordset
Dim bFoundMatch As Boolean
Set dbs = CurrentDb
Set rstUserPwd = dbs.OpenRecordset("qryUserPwd")
bFoundMatch = False
If rstUserPwd.RecordCount > 0 Then
rstUserPwd.MoveFirst
' check for matching records
Do While rstUserPwd.EOF = True
If rstUserPwd![UserName] = frmLogin.txtUsername.Value And rstUserPwd![Password] = frmLogin.txtPassword.Value Then
bFoundMatch = True
Exit Do
End If
rstUserPwd.MoveNext
Loop
End If
If bFoundMatch = True Then
'Open the next form here and close this one
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "frmNavigation"
Else
'
MsgBox "Incorrect Username or Password"
End If
rstUserPwd.Close
End Sub
Even though I enter the correct username and password I get the "Incorrect Username or Password message pop up. Can anyone help by telling me what I have done wrong please. If needed I can add a copy of the database.
Carefully consider the logic in this line ...
Do While rstUserPwd.EOF = True
That says to VBA, "run the code in this block while the condition is True". However, when you first encounter that line, your recordset's current row is the first row (as a result of MoveFirst). And therefore EOF is False, and since False is not equal to True, the code in the Do While loop is not run.
My first guess is you want something like this to control the loop.
Do While Not rstUserPwd.EOF
That change might get your code working as you intend. However that approach is more complicated than necessary. Instead of opening a recordset and walking the rows to check for a user name and password match, you could use a DCount expression.
I asume the username and password are both string values and would suggest changing your code as following:
Dim sSql As String
Dim rstUserPwd As DAO.Recordset
Dim bFoundMatch As Boolean
sSql = "Select * from qryUserPwd Where UserName='" & Nz(frmLogin.txtUsername, "") & "' And Password = '" & Nz(frmLogin.txtPassword, "") & "'"
Set rstUserPwd = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
If Not (rstUserPwd.BOF And rstUserPwd.EOF) Then
bFoundMatch = True
End If
rstUserPwd.Close: Set rstUserPwd = Nothing
If bFoundMatch = True Then
'Open the next form here and close this one
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "frmNavigation"
Else
'
MsgBox "Incorrect Username or Password"
End If
You could also use this 1 liner:
bFoundMatch = DCount("*", "qryUserPwd", "UserName = '" & frmLogin.txtUsername & "' And Password = '" & frmLogin.txtPassword & "'") > 0
I have a form which contains a subform which displays editable fields linked to one my tables. For a project I'm currently working on, one of the requirements is that I have to track when the last change was made to a record and who did so.
So what I've done is for each editable textbox or combobox within the form and subform I've made it so they have events on their BeforeUpdate and AfterUpdate events.
For example my BeforeUpdate for a textbox:
Private Sub textbox_BeforeUpdate(Cancel As Integer)
If Not isValidUser Then
Cancel = True
Me.textbox.Undo
End If
End Sub
and my AfterUpdate is:
Private Sub textbox_AfterUpdate()
updateRecord Me.textbox.Value, UserNameWindows
End Sub
and updateRecord is:
Public Sub updateRecord(bucNumber As String, updater As String)
Dim Dbs As Object
Dim rst As Object
Dim fldEnumerator As Object
Dim fldColumns As Object
sqlStatement = "SELECT fName " & _
"FROM t_Staff " & _
"WHERE uName='" & updater & "';"
'Getting fullname of user via username
Set rst = CurrentDb.OpenRecordset(sqlStatement)
'Setting fullname to updater variable
updater = rst(0)
'Clean Up
Set rst = Nothing
'Opening Bucket Contents
Set Dbs = CurrentDb
Set rst = Dbs.OpenRecordset("Bucket Contents")
Set fldColumns = rst.Fields
'Scan the records from beginning to each
While Not rst.EOF
'Check the current column
For Each fldEnumerator In rst.Fields
'If the column is named Bucket No
If fldEnumerator.Name = "Bucket No" Then
'If the Bucket No of the current record is the same as bucketNumber
If fldEnumerator.Value = bucNumber Then
'Then change the updated fields by updater and todays date
rst.Edit
rst("Last Updated By").Value = updater
rst("Last Updated On").Value = Date
rst.Update
End If
End If
Next
'Move to the next record and continue the same approach
rst.MoveNext
Wend
'Clean Up
Set rst = Nothing
Set Dbs = Nothing
End Sub
Okay now is the weird thing, this works totally fine when I make a modification to a control within the Main form, however as soon as a try to alter something in the subform it throws up a write conflict.
If I opt to save record it ignores my code for updating who last modified it and when and if I opt to discard the change it runs my code and updates it that it has been changed!
Anyone know what is wrong or of a better way to do this?
I have a simple query tied to a command button that shows a summary of the values in a particular field. It's running on a table that changes with each use of the database, so sometimes the table will contain this field and sometimes it won't. When the field (called Language) is not in the file, the user clicks the command button and gets the "Enter Parameter Value" message box. If they hit cancel they then get my message box explaining the field is not present in the file. I would like to bypass the "Enter Parameter Value" and go straight to the message if the field is not found. Here is my code:
Private Sub LangCount_Click()
DoCmd.SetWarnings False
On Error GoTo Err_LangCount_Click
Dim stDocName As String
stDocName = "LanguageCount"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Err_LangCount_Click:
MsgBox "No Language field found in Scrubbed file"
Exit_LangCount_Click:
Exit Sub
DoCmd.SetWarnings True
End Sub
You can attempt to open a recordset based on the query before you run the query:
Set rs = CurrentDb.QueryDefs("query1").OpenRecordset
This will go straight to the error coding if anything is wrong with the query.
Alternatively, if it is always the language field and always in the same table, you can:
sSQL = "select language from table1 where 1=2"
CurrentDb.OpenRecordset sSQL
This will also fail and go to your error coding, but if it does not fail, you will have a much smaller recordset, one with zero records.
You can easily enough get a list of fields in a table with ADO Schemas:
Dim cn As Object ''ADODB.Connection
Dim i As Integer, msg As String
Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaColumns, Array(Null, Null, "Scrubbed"))
While Not rs.EOF
i = i + 1
msg = msg & rs!COLUMN_NAME & vbCrLf
rs.MoveNext
Wend
msg = "Fields: " & i & vbCrLf & msg
MsgBox msg
More info: http://support.microsoft.com/kb/186246
You have a command button named LangCount. It's click event has to deal with the possibility that a field named Language is not present in your Scrubbed table.
So then consider why a user should be able to click that command button when the Language field is not present. When the field is not present, you know the OpenQuery won't work (right?) ... so just disable the command button.
See if the following approach points you to something useful.
Private Sub Form_Load()
Me.LangCount.Enabled = FieldExists("Language", "Scrubbed")
End Sub
That could work if the structure of Scrubbed doesn't change after your form is opened. If the form also includes an option to revise Scrubbed structure, update LangCount.Enabled from that operation.
Here is a quick & dirty (minimally tested, no error handling) FieldExists() function to get you started.
Public Function FieldExists(ByVal pField As String, _
ByVal pTable As String) As Boolean
Dim blnReturn As Boolean
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
Set db = CurrentDb
' next line will throw error #3265 (Item not found in this collection) '
' if table named by pTable does not exist in current database '
Set tdf = db.TableDefs(pTable)
'next line is not actually needed '
blnReturn = False
For Each fld In tdf.Fields
If fld.Name = pField Then
blnReturn = True
Exit For
End If
Next fld
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
FieldExists = blnReturn
End Function
I'm having trouble trying to export an Access report to PDF format. Basically, I'm working on an old (built in 2001) Access database that uses forms as a user interface. Currently, you can send jobs from a "Jobs" form into an "Invoice" form. Once all the jobs are there, you simply click "Invoice All", specify a date and number of copies and this prints using an Access report as the template.
I've been tasked with adding a save as PDF function, but being a web designer by trade, I have very limited knowledge of Access and VB, but I do know a (very) little amount of ASP.Net and C# (how I got given this task is story for another time...)
In my mind I've approached this by creating a new PDF button on the Access form where they print the invoices. My thoughts are that I could simply duplicate the code for the printing and update to output to a PDF file instead. I can kind of get this working, but not how I'd like.
The code for the print function is below:
Private Sub cmdOpenGroupInvoice_Click()
Dim db As DAO.Database
Dim rsGetCustomerInvoice As DAO.Recordset
Dim rsInvoice As DAO.Recordset
Dim rsInvoiceAll As DAO.Recordset
Dim lngCusID As Long
Dim lngJobNo As Long
Dim iCountInvoice
Dim lngInvoiceNo As Long
Dim iNumberCopies As Integer
Dim sSQLGetInv As String
Dim sSQLInv As String
Dim datInvoiceDate As Date
sSQLGetInv = "SELECT tblJobs.JobNo,tblJobs.NetDespatchRef, tblLoads.Sales, tblLoads.PODName, tblLoads.TotalSales, tblLoads.Cost, tblLoads.Profit, tblJobs.SendToInvoice, tblJobs.Invoiced, tblJobs.MarkForHistory, tblJobs.CustomerID" & vbCrLf _
& "FROM tblJobs INNER JOIN tblLoads ON tblJobs.JobNo = tblLoads.JobNo" & vbCrLf _
& "WHERE (((tblJobs.SendToInvoice)=Yes) AND ((tblJobs.Invoiced)=No) AND ((tblJobs.MarkForHistory)=No));"
Set db = CurrentDb
Set rsGetCustomerInvoice = db.OpenRecordset(sSQLGetInv, dbOpenDynaset)
If rsGetCustomerInvoice.EOF Then
Beep
If MsgBox("There are no jobs to invoice", _
vbCritical + vbOKOnly, _
"No Jobs To Invoice") = vbOK Then
Exit Sub
End If
End If
rsGetCustomerInvoice.MoveLast
Debug.Print rsGetCustomerInvoice.RecordCount
rsGetCustomerInvoice.MoveFirst
Do Until rsGetCustomerInvoice.EOF = True
Set rsGetCustomerInvoice = db.OpenRecordset(sSQLGetInv, dbOpenDynaset)
If rsGetCustomerInvoice.EOF Then
rsGetCustomerInvoice.Close
db.Close
Set rsGetCustomerInvoice = Nothing
Set db = Nothing
DoCmd.Close acForm, "frmInvoiceDate"
Exit Sub
End If
Debug.Print rsGetCustomerInvoice.RecordCount
datInvoiceDate = CVDate(txtInvoiceDate)
lngInvoiceNo = GiveMeAnInvoiceNo()
lngCusID = rsGetCustomerInvoice.Fields!CustomerID
Call AddNewInvoice(lngInvoiceNo, datInvoiceDate, True)
Debug.Print iCountInvoice
lngJobNo = rsGetCustomerInvoice![JobNo]
Call SendThisJobToSageAll(lngCusID, datInvoiceDate, lngInvoiceNo)
Call InvoiceAll(lngCusID, lngInvoiceNo)
Dim strPODName As String
If Not IsNull(rsGetCustomerInvoice!NetDespatchRef) Then
If IsNull(rsGetCustomerInvoice![PODName]) Then
strPODName = " "
Else
strPODName = rsGetCustomerInvoice![PODName]
End If
'Call NetDesTrackingJobCompleate(rsGetCustomerInvoice![NetDespatchRef], rsGetCustomerInvoice![JobNo], strPODName)
End If
iCountInvoice = iCountInvoice - 1
'Debug.Print I
iNumberCopies = txtNumberOfCopies
Do Until iNumberCopies = 0
DoCmd.OpenReport "rptInvoice2", acViewNormal, , "[Invoice No]= " & lngInvoiceNo
iNumberCopies = iNumberCopies - 1
Loop
Form_frmInvoicing.Requery
rsGetCustomerInvoice.MoveNext
Loop
DoCmd.Close acForm, "frmInvoiceDate"
rsGetCustomerInvoice.Close
db.Close
Set rsGetCustomerInvoice = Nothing
Set db = Nothing
End Sub
With my original plan outlined above, I updated the below section to output to PDF:
Do Until iNumberCopies = 0
DoCmd.OpenReport "rptInvoice2", acViewNormal, , "[Invoice No]= " & lngInvoiceNo
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, True
iNumberCopies = iNumberCopies - 1
Loop
Now this works and it does attempt to output a PDF file. The trouble is, it's runs the report and creates an invoice for every job in the system, rather than applying the report to JUST the jobs which are marked for invoicing.
I'm hoping this is happening because I've put the code in the wrong location, but I have a gut feeling that it's more complicated than that.
It's a bit of a long shot posting it on here, but I really appreciate any help at this point. I've also tried to keep this as short as possible, so if there's any details which aren't clear, I'll help out.
That is quite convoluted, so I think the simplest thing to do, if you do not wish to dive in and tidy up, is to modify the query that the report is based on.
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("MyReportQuery")
sSQL = "SELECT Whatever FROM MyTable WHERE [Invoice No]= " & lngInvoiceNo
qdf.SQL = sSQL
DoCmd.OutputTo acOutputReport, "rptInvoice2", acFormatPDF, _
MyPath & MyFilename, True
Unless you have Access 2007 with the Save as PDF Add-on or 2010, you may be best installing say, cutePDF, and printing to the PDF printer using DoCmd.PrintOut
I asked the same question a couple of years ago on UtterAccess..
There is a free library to do exactly what you need here: http://www.lebans.com/reporttopdf.htm
My original thread at UA is here : http://www.utteraccess.com/forum/Automatically-PDF-send-t1353547.html
I successfully used the library for a couple of years in several projects, mainly to generate quotes and invoices.
Hope this helps
PG