I have two pieces of code in my form constructor. They are equal for a 95%, but I really don't know how to simplify it (VB newbie, came from PHP/C/C++/other non-script languages). Can someone help me with it? How to make a template, or just make a shared class or just some globals to use it? :-o
Pieces are:
Private Sub AddOne_Click()
If isNull(Forms![Constructor]!FieldOne.value) Then
MsgBox ("Please, fill the field one")
Else
Dim workspace As DAO.workspace
Dim recordset As DAO.recordset
Set workspace = DBEngine.Workspaces(0) 'The current database
workspace.BeginTrans 'Start the transaction buffer
Set recordset = CurrentDb.OpenRecordset("One", dbOpenDynaset)
With recordset
.AddNew
!One = Forms![Constructor]!FieldOne.value
.Update
End With
workspace.CommitTrans 'Commit the transaction to dataset
MsgBox ("New '" + Forms![Constructor]!FieldOne.value + "' added successfully")
Forms![Constructor]!FieldOne.value = Null
End If
End Sub
Private Sub AddTwo_Click()
If isNull(Forms![Constructor]!FieldTwo.value) Then
MsgBox ("Please, fill the field two")
Else
Dim workspace As DAO.workspace
Dim recordset As DAO.recordset
Set workspace = DBEngine.Workspaces(0) 'The current database
workspace.BeginTrans 'Start the transaction buffer
Set recordset = CurrentDb.OpenRecordset("Two", dbOpenDynaset)
With recordset
.AddNew
!Two = Forms![Constructor]!FieldTwo.value
.Update
End With
workspace.CommitTrans 'Commit the transaction to dataset
MsgBox ("New '" + Forms![Constructor]!FieldTwo.value + "' added successfully")
Forms![Constructor]!FieldTwo.value = Null
End If
End Sub
Not sure why you've tagged this 'vbscript' - looks like Access to me (OTOH it's impossible to type a variable in VBScript, and OTH you've used the 'bang' operator). Anyhow:
1) Add a standard module.
2) Add the following helper routine to the module:
Function Add(RecordsetName As String, FieldName As String)
If isNull(Forms![Constructor].Fields(FieldName).value) Then
MsgBox ("Please, fill " + FieldName)
Else
Dim workspace As DAO.workspace
Dim recordset As DAO.recordset
Set workspace = DBEngine.Workspaces(0) 'The current database
workspace.BeginTrans 'Start the transaction buffer
Set recordset = CurrentDb.OpenRecordset(RecordsetName, dbOpenDynaset)
With recordset
.AddNew
.Fields(FieldName).Value = Forms![Constructor].FieldName(FieldName).value
.Update
End With
workspace.CommitTrans 'Commit the transaction to dataset
MsgBox ("New '" + Forms![Constructor].Fields(FieldName).value + "' added successfully")
Forms![Constructor].Fields(FieldName).value = Null
End If
End Sub
3) The existing OnClick handlers can now be replaced with
=Add("One", "FieldOne")
and
=Add("Two", "FieldTwo")
in the Properties pane and the current method handlers deleted from the form module.
Related
I have a code now that will go to the next record, but in the form it will not display the next record just shows 0. You can see in the table that the code is working and going to the next record seeing that the quantity went down. Another problem is when switched to the next record and that one hits 0, I'm then getting a highlighted error on my .Update when I need it to go to the next one after that. It doesn't say an error, I just assume when it's highlighted then the problem is coming from that. Its basically like the code isn't restarting. Here is my code now:
Private Sub ItemCode_Dirty(Cancel As Integer)
Dim Db As DAO.Database
Dim rs As DAO.Recordset
Set Db = CurrentDb
Set rs = Db.OpenRecordset("Select WrkordNum, ToGo from WorkOrders where ItemCode =" & Me.ItemCode)
With rs
If Not .EOF Then
If !ToGo <= 0 Then
.MoveNext
End If
.Edit
!ToGo = !ToGo - 1
.Update
End If
End With
End Sub
How do I get that next record to display in my form and not just show 0? What can I add in my code to have it restart to the beginning so that I works through the table and not just one record?
You've opened a new recordset. This has no relation to your current form at all. You can do this from outside a form. You can even do this from Excel.
If you want to interact with the form you have to use form methods.
If you just want to go to the next record you would use code like this:
If Me.CurrentRecord < Me.Recordset.RecordCount Then
DoCmd.GoToRecord , , acMoveNext
End If
If you want to move your form to the same record as your new recordset you would do this:
Private Sub ItemCode_Dirty(Cancel As Integer)
Dim Db As DAO.Database
Dim rs As DAO.Recordset
Set Db = CurrentDb
Set rs = Db.OpenRecordset("Select WrkordNum, ToGo from WorkOrders where ItemCode =" & Me.ItemCode)
With rs
If Not .EOF Then
If !ToGo <= 0 Then
.MoveNext
End If
.Edit
!ToGo = !ToGo - 1
.Update
Me.CurrentRecord = rs.AbsolutePosition
End If
End With
End Sub
and finally, if you want to work with the current recordset instead of opening a new one:
Private Sub ItemCode_Dirty(Cancel As Integer)
With Me.Recordset
If Not .EOF Then
If .ToGo <= 0 Then
.MoveNext
End If
.Edit
.ToGo = .ToGo - 1
.Update
End If
End With
End Sub
I'm having an issue with figuring out how to update my forms textbox with the value I ended with in the procedure. If a messagebox is used the output is fine. However, I want the user to be able to click the button and the textbox on that form be updated with the answer.
Private Sub btnTotalGuests_Click()
Call CalculateTotalGuestsForEachService
End Sub
Here is the procedure
Public Sub CalculateTotalGuestsForEachService()
'Declare variables
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intTotalParty As Integer
Dim intID As Integer
'Set the current database
Set db = CurrentDb
'Set the recordset
intID = InputBox("Enter the Service ID (1-6)", "Service ID")
Set rst = db.OpenRecordset("Select Orders.* From Orders Where ServiceID =" & intID)
'Cycle through the records
Do While Not rst.EOF
If Not IsNull(rst!NoInParty) Then
intTotalParty = intTotalParty + rst!NoInParty
End If
rst.MoveNext
Loop
'Display total amount
txtTotalGuests.Text = intTotalParty 'Wondering how to display this in the textbox on the form.
'Close the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
Don't use Text property. You want Value property and since Value is default, don't even need to explicitly reference. Presume CalculateTotalGuestsForEachService is in the form module so can use Me.txtTotalGuests.
Consider domain aggregate function instead of looping recordset.
Dim intID As Integer
intID = InputBox("Enter the Service ID (1-6)", "Service ID")
Me.txtTotalGuests = DSum("NoInParty", "Order", "ServiceID =" & intID)
I have an Access project (in Office 2016) which consist of several tables and forms. Also I've designed a user login method which using it, some users must access specific records that I've tried setting them on form load event by following code. One field of my table tbPrimary is initial File which is of type attachment that some other user fill it with images\Word documents\Excel files etc. When I try fill an attachment control with recordset result I get error 438 while other controls fill properly. (error at: Me.InitialFile = rs![Initial File].) Here's the code:
Public Sub Form_Load()
Dim rs As DAO.Recordset ''Requires reference to Microsoft DAO x.x Library
Dim sSQL As String
Dim strSQL As String
Dim nn As Double
sSQL = "SELECT MIN(tbPrimary.[ID]) As mm FROM tbPrimary WHERE Translator IS NULL"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL)
If rs.RecordCount > 0 Then
Me.tbSearch1 = rs!mm
Else
Me.tbSearch1 = "N/A"
End If
nn = CDbl(rs!mm)
strSQL = "SELECT * FROM tbPrimary WHERE ID= " & nn & ""
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount > 0 Then
Me!ID = rs!ID
Me.tbInitial_Name = rs![Initial Name]
Me.length = rs!length
Me.Level1_Menu = rs![level1 Menu]
Me.Level2_Menu = rs![level2 Menu]
Me.Level3_Menu = rs![level3 Menu]
Me.Type = rs![Type]
Me.Description = rs!Description
Me.tbMiningDate = rs![Mining Date]
Me.Created = rs!Created
Me.InitialFile = rs![Initial File]
Else
Me.tbSearch1 = "N/A"
End If
Me.Translator.SetFocus
End Sub
(any solution?
Thanks in advance)
Here is a general approach to adding attachments to an Access DB, I hope it helps.
Option Explicit
Sub ExampleAddAccessAttachment()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsattach As DAO.Recordset
Dim fldattach As DAO.Field
Dim filepath As String
filepath = "SOME FILE PATH HERE"
Set db = CurrentDb
'Open a recordset to the table with the attachment
Set rs = db.OpenRecordset("Select * from SOMETABLENAME")
With rs
.AddNew
'The attachment field is a multipart field, so we can treat as a recordset
Set rsattach = .Fields("TheAttachmentFieldName").Value
'Get the fileData Field, this holds the data
Set fldattach = rsattach.Fields("FileData")
'Add a new record to this recordset, you can add multiple
rsattach.AddNew
'Use the load from file method to add a file to the attachment
fldattach.LoadFromFile (filepath)
'Update the recordset with the attachment
rsattach.Update
'Update the parent table recordset
.Update
End With
End Sub
I have a SQL query that I'm calling from a couple of different forms using the ctrl as object method. It works fine, but when I run it from a click event it will also open whichever form isn't currently loaded. The query returns the results I want, it just does it to both forms at the same time regardless of which is loaded.
Only one form is loaded at a time. A drop down list called Team exists on both forms. The query passes the currently selected item from that drop down list to return a list of agents assigned to that team.
I know that part of the issue is my query using an or statement that refers to values on both forms, but I'm not sure how to change it to reference the active form.
Attendance and reporting are the names of the two UserForms currently calling this query. Both of them have combobox controls named Team. I've tried activeform, etc. But I can't seem to find a way to make it work.
Sub agents(ctrl As Object)
database_connect
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim Counter As Long
SQLStr="select distinct[Agentname] from dbo.[Attendance] Where [Team]='" & _
attendance.Team.Value & "' or [Team] ='" & Reporting.Team.Value & "'"
If appconn.State = 0 Then
Call database_connect
End If
rs.Open SQLStr, appconn, adOpenStatic
With ctrl
Do
.AddItem rs![Agentname]
rs.MoveNext
Loop Until rs.EOF
End With
rs.Close
database_Disconnect
Set rs = Nothing
Exit Sub
End Sub
1) Well first off to refer to controls you have to have the form loaded.
2) Youre referring to controls in the oddest way. Review AND save this URL http://access.mvps.org/access/forms/frm0031.htm
3) If one form is closed your query might always return nothing. Is this a desired output?
For anyone who may find this looking for something similar, this is the solution I used.
I used a Function to test if a userform is loaded or not.
Public Function IsLoaded(formName As String) As Boolean
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = formName Then
IsLoaded = True
Exit Function
End If
Next frm
IsLoaded = False
End Function
Then adjusted my above code like so
database_connect
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim Counter As Long
If IsLoaded("Attendance") Then
SQLStr = "select distinct[Agentname] from dbo.[Attendance] Where [Team] ='" & attendance.Team.value & "'"
ElseIf IsLoaded("Reporting") Then
SQLStr = "select distinct[Agentname] from dbo.[Attendance] Where [Team] ='" & Reporting.Team.value & "'"
End If
If appconn.State = 0 Then
Call database_connect
End If
rs.Open SQLStr, appconn, adOpenStatic
With ctrl
Do
.AddItem rs![Agentname]
rs.MoveNext
Loop Until rs.EOF
End With
rs.Close
database_Disconnect
Set rs = Nothing
Exit Sub
now it works like a charm!
I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function