A report is called from VBA to receive returned records from an Access pass-through query. After the DoCmd completes the report's parameters are set in the report's appropriate label containers setting their .Caption property as required. Access fails intermittently during this process which leads me to believe that the report is not truly open to receive the parameters. Here's the VBA sub:
Private Sub Report_Open(Cancel As Integer)
Dim strFromDate As String
Dim strToDate As String
Dim strWC As String
Dim intShift As Integer
Dim strSQL As String
strFromDate = InputBox("Enter From Date and Time: ")
strToDate = InputBox("Enter To Date and Time: ")
strWC = InputBox("Enter Work Center: ")
intShift = InputBox("Enter Shift: ")
strSQL = "exec dbo.uspWorkCentreReport_TEST " & "'" & strFromDate & "', " & "'" & strToDate & "', " & "'" & strWC & "', " & intShift & ";"
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQL
DoCmd.OpenReport "rpt_qry_ptq_uspWorkCentreReport", acViewReport
Me.lblFromDate.Caption = strFromDate
Me.lblToDate.Caption = strToDate
Me.lblWC.Caption = strWC
Me.lblShift.Caption = intShift
End Sub
When the failure occurrs VBA highlights the Me.lblFromDate.Caption = strFromDate. If I press Reset in VBA or End on the Run-time error '2467': dialog, Access abends without any other outward signs. Access then re-opens to save the copied *_Backupx.accdb and opens with a fresh copy of the .accdb. The error seems to be a standars MS error:
As I said the report is intermittent and when it fails VB always highlights the same line in code. How do I capture what is happening or can I make VB wait a half of full second before it tries to write the parameters?
As I remember, captions can not be modified, when report open. Only in design mode. So this is not correct, because you have already opened report
Me.lblFromDate.Caption = strFromDate
You should use text boxes instead of captions. Also you can clear the borders, fillings and so on, that text box will appear like a caption.
Finally the correct set of code was produced. The button click creates strOpenArgs and passes it with .OpenReport. The report opens and splits the OpenArgs and populates the appropriate labels with updated Captions. Text boxes would not work! Here's the button click event:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub
And here's the reports _Open:
Private Sub Report_Open(Cancel As Integer)
Dim SplitOpenArgs() As String
SplitOpenArgs = Split(Me.OpenArgs, "|")
Me.lblFromDate.Caption = SplitOpenArgs(1)
Me.lblToDate.Caption = SplitOpenArgs(2)
Me.lblWC.Caption = SplitOpenArgs(3)
Me.lblShift.Caption = SplitOpenArgs(4)
End Sub
This opens the report every time with new appropriate data, so long as the report is closed before the form's button is pressed again for another refresh of the report. If the report is not closed the report stays up with the original data and does not refresh with new data... But that is another question I am about to ask. Thanks All.
Related
I am updating a small medical database. So far all new products have been added manually / directly to a Products- table. I am creating a form to do that.
Even it is in a way very simple to do, I am facing up a problem that data is inserted correctly only if all fields have something typed in form, if any of the input boxes are left empty no new records are made.
Additionally a simple check for minimum fields is not working. It will step thru all controls correctly but does not stop even a field is left empty and its Tag has *-sign in it.
Insert into includes all fields which a defined in that table there is not any extra field in table except first field is autonumbered ID field. No need to type something in every field each time.
Pr
Private Function CheckAllFields() As Boolean
Dim Ctrl As Control
CheckAllFields = False
'Go through the controls in Form
'If control has tag (*) and it null (no value) then show alert
For Each Ctrl In Me.Controls
MsgBox Ctrl.Name
If Ctrl.Tag = "*" And IsNull(Ctrl) Then
Dim FieldName As String
FieldName = Ctrl.Name
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."
Ctrl.SetFocus
CheckAllFields = True
Exit For
End If
Next Ctrl
MsgBox "Check fileds done"
End Function
Private Sub AddProduct_Click()
Dim strSQL As String
'SQL to insert Product
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES ('" & Me.txtProductName & "','" & Me.txtProductDesc & "','" & Me.txtFinnishName & "','" & Me.txtFinnishDesc & "','" & Me.ComboMatrix & "'," & _
"'" & Me.txtAdditionalInfo & "','" & Me.ComboUnit & "','" & Me.CheckLicense & "'," & _
"'" & Me.txtRemarks & "','" & Me.CheckNarcotic & "','" & Me.CheckAsset & "'," & _
"'" & Me.txtATC & "','" & Me.txtCathegory & "','" & Me.txtEICcode & "','" & Me.txtEICName & "')"
'' MsgBox strSQL
'Check the all fields have valid format
If CheckAllFields = False Then
'Execute SQL in database - insert new batch
' MsgBox "Step into Check all fields"
CurrentDb.Execute strSQL
MsgBox "A new product inserted !"
End If
Here is a debug output of my insert into command:
Debug output
Here is another output debug, now the new product is inserted correctly.
Correctly working version
Problem solved. As Craig pointed this way of incuding parameters is prone to fail.
Here is good way to solve this. Did not believe it but after I tried it worked ultimate.
MS access running SQL doesn't insert data, no error
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES (ptxtProductName, ptxtProductDesc,ptxtFinnishName,ptxtFinnishDesc,pComboMatrix, ptxtAdditionalInfo,pComboUnit, pCheckLicense, ptxtRemarks, pCheckNarcotic, pCheckAsset, ptxtATC, ptxtCathegory, ptxtEICCode, ptxtEICName);"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL)
With qdf
.Parameters("ptxtProductName").Value = Me.txtProductName.Value
.Parameters("ptxtProductDesc").Value = Me.txtProductDesc.Value
.Parameters("ptxtFinnishName").Value = Me.txtFinnishName.Value
.Parameters("ptxtFinnishDesc").Value = Me.txtFinnishDesc.Value
.Parameters("pComboMatrix").Value = Me.ComboMatrix.Value
.Parameters("ptxtAdditionalInfo").Value = Me.txtAdditionalInfo.Value
.Parameters("pComboUnit").Value = Me.ComboUnit.Value
.Parameters("pCheckLicense").Value = Me.CheckLicense.Value
.Parameters("ptxtRemarks").Value = Me.txtRemarks.Value
.Parameters("pCheckNarcotic").Value = Me.CheckNarcotic.Value
.Parameters("pCheckAsset").Value = Me.CheckAsset.Value
.Parameters("ptxtATC").Value = Me.txtATC.Value
.Parameters("ptxtCathegory").Value = Me.txtCathegory.Value
.Parameters("ptxtEICCode").Value = Me.txtEICcode.Value
.Parameters("ptxtEICName").Value = Me.txtEICName.Value
.Execute dbFailOnError
End With
Debug.Print db.RecordsAffected
That check for empty fields is mystery, it works in another form so it has to be some sort of reference problem. Anyway to keep things simple this works perfectly:
If txtProductName.Value = "" Or ComboMatrix.Value = "" Or ComboUnit.Value = "" Then
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."
I am trying to compare two text fields txtTrailerNumber and txtSealNumber to the database table Tab_TrailerDetails. [TrailerNumber] and [SealNumber] as listed in the table.
I am trying to get the database to look at the trailer number entered into the form, and if it finds a duplicate value it then looks at the seal number entered into the form. If both values have a duplicate found in the table it should throw up the Msg_Box error code.
Private Sub txtSealNumber_AfterUpdate()
Dim NewTrailer, NewSeal As String
Dim stLinkCriteria As String
'Assign the entered Trailer Number and Seal Number to a variable
NewTrailer = Me.txtTrailerNumber.Value
NewSeal = Me.txtSealNumber.Value
stLinkCriteria = ("[TrailerNumber]='" & NewTrailer & "'" And "[SealNumber]='" & NewSeal & "'")
If Me.txtTrailerNumber = DLookup("[TrailerNumber]", "Tab_TrailerDetails", stLinkCriteria) Then
MsgBox "This trailer, " & NewTrailer & ", has already been entered in database," _
& vbCr & vbCr & "along with seal " & NewSeal & "" _
& vbCr & vbCr & "Please make sure Trailer and Seal are not already entered.", vbInformation, "Duplicate information"
'undo the process and clear all fields
Me.Undo
End If
End Sub
The cause of the error is that you have a logical keyword, notably AND inside a string expression. Change your code to
stLinkCriteria = ("[TrailerNumber]='" & NewTrailer & "' And [SealNumber]='" & NewSeal & "'")
I'm using a COM interface to export animations from a third-party program. I'm sending an exporting COM command with script from my tool with a shell command.
There's a problem with when I send the animation export command to the third-party tool. It starts to export, but my tool is sending a second animation export command while the last one is not finished. How can I prevent from this situation?
I'd like to sending my shell command from the for loop after the file was created.
My code is like below.
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
Try
Dim strArgument As String
Dim strfilePathEV As String
Dim strfilePathANI As String
Dim strfilePathPIC As String
strfilePathEV = strProjMdlDir & My.Settings.txtCheckSolverOuputDir & strProjMdlName & ".ev.sbr"
strfilePathANI = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirANI & "\"
strfilePathPIC = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirPIC & "\"
For i As Integer = 0 To dgvCheckSolveEva.RowCount - 1
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Shell(My.Settings.txtSpckDir & "simpack-post.exe -s qs_mode_shape.qs " & strArgument)
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
I'd like to continue my for loop if strfilePathANI & strProjMdlName & "_" & i & ".mpg", the animation file was created, so I can start to export the next one.
The best way would be to use the .NET Process class and call the WaitForExit() method in order to wait for simpack-post.exe to close itself.
Shell() is an outdated function from the VB6-era which exists purely for partial backwards compatibility with that language. It shouldn't be used in new code.
Basic example:
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
The problem with this of course is that it might block the UI thread and thus cause it to freeze, depending on how long it takes for the process to exit. Therefore we should wrap it in a Task:
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Task.Run( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
Just note that you cannot directly access the UI from within the task. If you want to do so you need to Invoke.
EDIT:
If you are targeting .NET Framework 3.5 or lower, or using VS 2008 or lower, tasks aren't available and we have to resort to using regular threads and/or regular methods instead of lamba expressions.
Note that the same rules apply, though - you cannot access the UI without invoking.
.NET 3.5 (or lower) using VS 2010 (and higher):
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
t.IsBackground = True
t.Start()
.NET 3.5 (or lower) using VS 2008 (or lower):
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
...your code...
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread(New ParameterizedThreadStart(AddressOf ExportAnimationsThread))
t.IsBackground = True
t.Start(c)
...your code...
End Sub
Private Sub ExportAnimationsThread(ByVal Count As Integer)
For i As Integer = 0 To Count
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub
I use the following code in vba access to update a column of a table, but it is not working. Please help me.
Best regards.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& "SET Assay.assay_repeat = " & 0 & "" _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
DoCmd.RunSQL sqlupdate
You have an extra double quote and are missing a couple of spaces - try it like this:
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& " SET Assay.assay_repeat = " & 0 & " _
& " WHERE (((Assay.[assay_repeat])= " & 1 & "));"
You just missed space chars at end of the table name and before where.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay " _
& "SET Assay.assay_repeat = " & 0 & " " _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
Here is a great way to convert a SQL string to VBA code.
Creating the form
The form just needs two text boxes, and a command button. SQL statements can be quite long, so you put the text boxes on different pages of a tab control.
Create a new form (in design view.)
Add a tab control.
In the first page of the tab control, add a unbound text box.
Set its Name property to txtSql.
Increase its Height and Width so you can see many long lines at once.
In the second page of the tab control, add another unbound text box.
Name it txtVBA, and increase its height and width.
Above the tab control, add a command button.
Name it cmdSql2Vba.
Set its On Click property to [Event Procedure].
Click the Build button (...) beside this property.
When Access opens the code window, set up the code like this:
Private Sub cmdSql2Vba_Click()
Dim strSql As String
'Purpose: Convert a SQL statement into a string to paste into VBA code.
Const strcLineEnd = " "" & vbCrLf & _" & vbCrLf & """"
If IsNull(Me.txtSQL) Then
Beep
Else
strSql = Me.txtSQL
strSql = Replace(strSql, """", """""") 'Double up any quotes.
strSql = Replace(strSql, vbCrLf, strcLineEnd)
strSql = "strSql = """ & strSql & """"
Me.txtVBA = strSql
Me.txtVBA.SetFocus
RunCommand acCmdCopy
End If
End Sub
http://allenbrowne.com/ser-71.html
I recommend you use Recordsets.
Private Sub Update_My_Records(Parent As Object)
Dim Data_Recset As Object
Dim Parent_Reference As Object
Set Data_Recset = Parent_Reference.Application.DBEngine.Workspaces(0).Databases(0).OpenRecordset("SELECT * FROM Assay WHERE assay_repeat = " & 0 & ";", DB_OPEN_DYNASET)
Data_Recset.MoveLast
Data_Recset.MoveFirst
Data_Recset.Edit
Data_Recset.Fields("assay_repeat") = 1
Data_Recset.Update
Data_Recset.Close
Set Data_Recset = Nothing
End Sub
assumptions
Parent has reference to Access.Application. (I usually pass: Form.Module.Parent reference to Sub/Function)
the table or query "Assay" already exists.
You only need to update 1 row at a time
But if you want to use Queries In Your Form:
Private Sub Query_Definition_Update()
Dim Obj_Qdef As Object
Dim Query_Name As String
Query_Name = "Q_Assay"
Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs.Refresh
Set Obj_Qdef = Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs(Query_Name)
Obj_Qdef.SQL = Query_Update(1)
Debug.Print Obj_Qdef.SQL
Obj_Qdef.Execute
''When finished updating
Obj_Qdef.Close
Set Obj_Qdef = Nothing
End Sub
'------------------------------------------------------------'
Private Function Query_Update(New_Value as Integer) As String
Query_Update = "UPDATE Assay" & _
" SET Assay.assay_repeat = " & 0 & "" & _
" WHERE (((Assay.[assay_repeat])= " & New_Value & "));"
End Sub
Good day guys, I have a question. When I try to use this piece of code in my program which will add a supplier to the database, I encounter data type mismatch error. As far as I know, the status of the supplier creates the error.
How would I store the values of the radio buttons named radActive and radInactive in the database? Should I use Boolean or a String? I am using Microsoft Access as my database and the field of Status is set to Yes/No.
Here's the code.
Public Sub SupplierInsertData()
Dim conn As OleDb.OleDbConnection
Dim cmd As OleDb.OleDbCommand
Dim SupplierType As String
Dim Status As Boolean
'Check for supplier type
If frmDatabaseSupplier.radLocal.Checked = True Then
SupplierType = "Local"
ElseIf frmDatabaseSupplier.radForeign.Checked = True Then
SupplierType = "Foreign"
End If
'Check for supplier status
If frmDatabaseSupplier.radActive.Checked = True Then
Status = True
ElseIf frmDatabaseSupplier.radInactive.Checked = True Then
Status = False
End If
'For inserting of data in the database.
Dim cmdString As String = "INSERT INTO Supplier(SupplierLastName, SupplierFirstName, SupplierMiddleInitial, " & _
"SupplierCompany, SupplierType, SupplierStreetAddress, SupplierCity, SupplierContactNumber, SupplierEmail, " & _
"Status)" & _
"VALUES('" & frmDatabaseSupplier.txtSupplierLastName.Text & "','" & frmDatabaseSupplier.txtSupplierFirstName.Text & "','" & frmDatabaseSupplier.txtSupplierMiddleInitial.Text & "','" _
& frmDatabaseSupplier.txtSupplierCompany.Text & "','" & SupplierType & "', '" & frmDatabaseSupplier.txtSupplierStreetAddress.Text & "','" & frmDatabaseSupplier.txtSupplierCity.Text & "','" _
& frmDatabaseSupplier.txtSupplierContactNumber.Text & "','" & frmDatabaseSupplier.txtSupplierEmail.Text & "','" & Status & "')"
conn = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=|DataDirectory|\ProjectAnalysisSystem.accdb")
cmd = New OleDb.OleDbCommand(cmdString, conn)
conn.Open()
cmd.ExecuteNonQuery()
conn.Close()
End Sub
Thank you!
Try to change the last part of your code.
You should use parameters to pass the values of your textbox or vars to the database engine.
And don't forget to encapsulate the disposable objects like OleDbConnection in a using statement.
Dim cmdString As String = "INSERT INTO Supplier(SupplierLastName, SupplierFirstName, SupplierMiddleInitial, " & _
"SupplierCompany, SupplierType, SupplierStreetAddress, SupplierCity, SupplierContactNumber, SupplierEmail, " & _
"Status)" & _
"VALUES(#supplierName, #supplierFirst, #supplierMiddle, #supplierCo, #supplierType, #supplierStreet, #supplierCity, " & _
"#supplierContact, #supplierMail, #status)"
Using conn As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=|DataDirectory|\ProjectAnalysisSystem.accdb")
Dim cmd As OleDbCommand = New OleDb.OleDbCommand(cmdString, conn))
cmd.Parameters.AddWithValue("#supplierName", frmDatabaseSupplier.txtSupplierLastName.Text)
cmd.Parameters.AddWithValue("#supplierFirst", frmDatabaseSupplier.txtSupplierFirstName.Text)
cmd.Parameters.AddWithValue("#supplierMiddle", frmDatabaseSupplier.txtSupplierMiddleInitial.Text)
cmd.Parameters.AddWithValue("#supplierCo", frmDatabaseSupplier.txtSupplierCompany.Text )
cmd.Parameters.AddWithValue("#supplierType", SupplierType)
cmd.Parameters.AddWithValue("#supplierStreet", frmDatabaseSupplier.txtSupplierStreetAddress.Text)
cmd.Parameters.AddWithValue("#supplierCity", frmDatabaseSupplier.txtSupplierCity.Text)
cmd.Parameters.AddWithValue("#supplierContact", frmDatabaseSupplier.txtSupplierContactNumber.Text)
cmd.Parameters.AddWithValue("#supplierMail", frmDatabaseSupplier.txtSupplierEmail.Text)
cmd.Parameters.AddWithValue("#status", Status) '<- Here the status var is correctly identified as a boolean, not as a string
conn.Open()
cmd.ExecuteNonQuery()
End Using
You have a data type mismatch error because your INSERT statement attempts to store a string value for the Status field whose data type is Yes/No.
This isn't really a VB.Net problem. You would get the very same error from Access' db engine if you were attempting the same thing from VBA. This is the output from the VBA procedure below.
INSERT INTO Supplier (Status)
VALUES('True')
Error -2147217913 (Data type mismatch in criteria expression.)
The procedure ...
Public Sub Ju_chan()
Dim cmdString As String
Dim Status As Boolean
Dim strMsg As String
On Error GoTo ErrorHandler
Status = True
cmdString = "INSERT INTO Supplier (Status)" & vbCrLf & _
"VALUES('" & Status & "')"
Debug.Print cmdString
CurrentProject.Connection.Execute cmdString
ExitHere:
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ")"
Debug.Print strMsg
GoTo ExitHere
End Sub
Please understand this is not intended to steer you away from using parameters. I only wanted to clarify why you're getting that error.