i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right record(would be one ID for each record in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below. The weird thing here is that if i double click it again it will refresh and open the right record without opening anymore windows.. How can i fix that? I dont want to do it twice :)
Public Sub sendMRBmail(mrbid)
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr (34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
This is what is inside a created vbs file
On Error Resume Next
dim accessApp
set accessApp = GetObject("S:\Quality Control\Quality DB\Quality Database.accdb")
accessApp.Run"sendMRBmail","231"
set accessApp = nothing
Thanks to all that made inputs, i already found the answer. I added acFormEdit at the end of my DoCmd and it worked, check below:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit
Related
I am creating a database for contact information for research participants. In it, I have a form with a command button that is supposed to save 1 of 2 possible reports as a pdf for each participant based on the value of one of the text fields on the form (which is linked to a table where the field is automatically calculated as 0 or 2). Basically if the value of this field is 0 then I want the "UnsignedLetter" report saved for that participant or if the value of this field is 2, I want the "SignedLetter" report saved.
I've got most of it working except when it comes to selecting the correct report to save. FindFirst seems to be the closest to being successful but it's not quite right. When I click the button for the code below, the participants coded as 0 get both versions of the report and not just the "UnsignedLetter" version. The same does not happen with the participants coded as 2. For example, on a recordset of 5 people with 3 coded as 2 and 2 coded as 0, I get 3 correct "SignedLetter" pdf's, 2 correct "UnsignedLetter" pdf's, and an additional 2 incorrect "SignedLetter" pdf's. This is the code I'm working with:
Private Sub SaveLetters_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
On Error GoTo Error_Handler
sFolder = Application.CurrentProject.Path & "\"
Set rs = Me.RecordsetClone
With rs
.FindFirst "OncID = 2"
Do While Not .EOF
DoCmd.OpenReport "SignedLetter", acViewPreview, , "[ID]=" & ![ID],
acHidden
sFile = Nz(![UNumber], "") & "_signed" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "SignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "SignedLetter"
.MoveNext
Loop
End With
With rs
.FindFirst "OncID = 0"
Do While Not .EOF
DoCmd.OpenReport "UnsignedLetter", acViewPreview, , "[ID]=" & ![ID], acHidden
sFile = Nz(![UNumber], "") & "_unsigned" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "UnsignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "UnsignedLetter"
.MoveNext
Loop
End With
MsgBox "Letters Sent to File", vbOKOnly + vbInformation, "Task Completed"
Application.FollowHyperlink sFolder
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmd_GenPDFs_Click" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Sub
I've been searching for 2 days at this point and I can't find any solutions. I've tried doing the 2 With rs's separately, using 1 With rs as after the Then portion of an If .NoMatch statement for the other, changing the calculation so it results in text and not a number, and anything else I can think of or find online. I feel like I'm within throwing distance of tears at this point and would really appreciate any help you guys have.
There is no need for FindFirst. Most of the code for both reports is the same. Use an If Then Else and a variable to select appropriate report and dynamically execute commands.
Dim sRpt As String
With Me.RecordsetClone
Do While Not .EOF
If !OncID = 0 Then
sRpt = "Unsigned"
Else
sRpt = "Signed"
End If
DoCmd.OpenReport sRpt & "Letter", acViewPreview, , "[ID]=" & ![ID], acHidden
DoCmd.OutputTo acOutputReport, , acFormatPDF, _
CurrentProject.Path & "\" & Nz(![UNumber], "") & "_" & sRpt & ".pdf"
DoCmd.Close
.MoveNext
Loop
End With
The code below creates an email. It only works on the first record of the db. Also, the code puts all of the fields in the body. I would like it to only put the fields that have "Request from Finance" in the field.
Private Sub cmdEMail_Click()
On Error GoTo cmdEMail_Click_Error
Dim OutApp As Object
Dim strEMail As String
Dim OutMail As Object
Dim strbody As String
strEMail = Me.EMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
& "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
& "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
& "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
& "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
& "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
& "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
& "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
& "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf
On Error Resume Next
If Me.ActiveWritingCode = "Request from Finance" Then
With OutMail
.To = strEMail
.CC = ""
.BCC = ""
.Subject = "Lilly EU 1005894 Time Code Request"
.Body = strbody & vbNewLine & .Body
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
On Error GoTo 0
Exit Sub
cmdEMail_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"
End Sub
Here is a generic script to loop through records in a table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
'rs.Edit
'rs!VendorYN = True
'rs("VendorYN") = True 'The other way to refer to a field
'rs.Update
'Save contact name into a variable
'sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
Here is another example which is quite good.
https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx
I have the following the detect duplicate product name when user enters a new record.
Private Sub ProdName_BeforeUpdate(Cancel As Integer)
Dim Product As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Set rsc = Me.RecordsetClone
Product = Me.ProdName.value
stLinkCriteria = "[ProdName]=" & "'" & Product & "'"
If DCount("ProdName", "ProdProduct", stLinkCriteria) > 0 Then
Me.Undo
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
Set rsc = Nothing
End Sub
The code checks and finds duplicate but after it displays the following error and doesn't go to the orginal record:
Run-time error '3420'
Object invalid or no longer set
Please can someone help me get it right?
Try to avoid the undo (or move it to the end) and do cancel the update:
If DCount("ProdName", "ProdProduct", stLinkCriteria) > 0 Then
Cancel = True
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
rsc.FindFirst stLinkCriteria
Me.Bookmark = rsc.Bookmark
End If
And you may even skip the DCount and must use the Text property:
Product = Me!ProdName.Text
stLinkCriteria = "[ProdName]=" & "'" & Product & "'"
rsc.FindFirst stLinkCriteria
Cancel = Not rsc.NoMatch
If Cancel = True Then
MsgBox "Warning duplicate entry " _
& Product & " has already been entered." _
& vbCr & vbCr & "You will now be taken to the record.", vbInformation _
, "Duplicate Information"
'Go to record of original product name
Me.Bookmark = rsc.Bookmark
End If
The Run-time Error 3420, Object Invalid or No Longer Set occurs when the form status is dirty, you can simply set the form dirty to false before .findFirst call.
If Me.Dirty Then
Me.Dirty = False
End If
Me.Recordset.FindFirst stLinkCriteria
I'm trying to update records in my form. It's a restaurant reservation system. Given the Table #, the form can let the user input the Customer ID of the person reserving, the reservation time and date. But when I click on the "update" button in my form, a text box will pop up with this:
And whatever I put in it, the runtime error "too few parameters. expected 1." pops up. Sometimes a "Reserved Error" will pop up. Could someone help me? It's the last step before I could finally finish this project.
This is my code for updating the record:
Private Sub Command8_Click()
On Error GoTo errHandling
Dim strSQL As String
strSQL = "UPDATE tblReserve SET CustomerID = " & """" & Me.txtCustID & """" & _
", ResDate = " & """" & Me.txtResDate & """" & ", ResTime = " & """" & Me.txtTime & """" & " WHERE TableNum =" & Me.TableNum
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
CurrentDb.Execute strSQL, dbFailOnError
DoCmd.Close
Exit Sub
errHandling:
MsgBox Err.Description
End Sub
Screenshot of VBA editor with Debug.Print strSQL
As revealed in our [chat][1], the essence of the problem was that [TableNum] is a text field and therefore its value had to be enclosed in quotes:
"... WHERE TableNum = '" & Me.TableNum & "'"
[1]: https://chat.stackoverflow.com/rooms/42746/discussion-between-nutellafella-and-gord-thompson)
Try something like this
strSQL = "UPDATE tblReserve SET CustomerID = " & Me.txtCustID & _
", ResDate = " & "'" & Me.txtResDate & "'" & ", ResTime = " & "'" & Me.txtTime & "'" & " WHERE TableNum =" & Me.TableNum
I am not sure why you have 2 sets of double quotes inside double quotes, I think what you were looking for is single quotes :)
However, there are much better ways to format sql than this. Also this seems like homework, so study up!
I am setting up a Audit Tracking system for the forms in my database. I am following the example from Susan Harkins Here
My code works for my form customers which is based off the customers table. Here is my code:
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Then
If .Value <> .OldValue Then
MsgBox "Step 1"
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
However, when I try to change data in my subform within the form I get an error "Operation is not supported for this type of object". I can see the error is occuring here:
If .Value <> .OldValue Then
My subform is based off of a query which is based off of three tables
I'm trying to change a customer price under Customer Products and keep a log of those changes. Is there something I'm missing or a work around.
Thank you for the help!
Temporarily disable your error handler like this:
'On Error GoTo ErrHandler
When you get the error notice about "operation not supported", choose Debug from the error dialog. That will allow you to find out more information about the current text box control which is triggering the error. Try the following statements in the Immediate window:
? ctl.Name
? ctl.ControlSource
? ctl.Enabled
? ctl.Locked
? ctl.Value
At least ctl.Name will identify which text box is triggering the error.
After examining the db, I'll suggest a function (IsOldValueAvailable) to indicate whether .OldValue is available for the current control. With that function, the AuditTrail procedure works after this change:
'If .ControlType = acTextBox Then
If IsOldValueAvailable(ctl) = True Then
And the function. It may still need more work, but I didn't spot any problems in my testing.
Public Function IsOldValueAvailable(ByRef ctl As Control) As Boolean
Dim blnReturn As Boolean
Dim strPrompt As String
Dim varOldValue As Variant
On Error GoTo ErrorHandler
Select Case ctl.ControlType
Case acTextBox
varOldValue = ctl.OldValue
blnReturn = True
Case Else
' ignore other control types; return False
blnReturn = False
End Select
ExitHere:
On Error GoTo 0
IsOldValueAvailable = blnReturn
Exit Function
ErrorHandler:
Select Case Err.Number
Case 3251 ' Operation is not supported for this type of object.
' pass
Case Else
strPrompt = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure IsOldValueAvailable"
MsgBox strPrompt, vbCritical, "IsOldValueAvailable Function Error"
End Select
blnReturn = False
Resume ExitHere
End Function