Append to table using unbound textbox - vba

I am trying to append two data points to a table using unbound textboxes. I can get one to populate properly, but the other one is coming over blank.
For this example the Criteria1 = 1 and Criteria2 = 9/24/19
Here is my code:
Dim StrSQL As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = Application.CurrentDb
Set qdf = db.QueryDefs("3 - GRUpload")
Dim Criteria1 As String
Dim Criteria2 As String
Criteria1 = Me!GRValue
Criterial2 = Me!GRDate
StrSQL = "Insert Into [*Master Records - 2 - GRs] ([GR Value], [GR Date]) Values(" & Criteria1 & ", " & Criteria2 & ")"
qdf.SQL = StrSQL
I attached a picture of the resulting query, but this is SQL if that's more helpful:
INSERT INTO [*Master Records - 2 - GRs] ([GR Value], [GR Date])
Select 1 As Exp1, Criteria2 AS Expr2;
I have tried several variations of the code, including:
Values(""" & Criteria1 & """, """ & Criteria2 & """)"
Which results in:
INSERT INTO [*Master Records - 2 - GRs] ([GR Value], [GR Date])
Select "1" As Exp1, "" AS Expr2;
So I'm at a loss... Could one of you point me in the right direction?
Thank you!

Date/time type field requires # delimiter for parameters. Text type use apostrophe (or doubled quote), numbers none. Try:
StrSQL = "Insert Into [*Master Records - 2 - GRs] ([GR Value], [GR Date]) " & _
Values(" & Criteria1 & ", #" & Criteria2 & "#)"
Strongly advise not to use spaces nor punctuation/special characters in naming convention.

Related

MS-Access Dynamically Convert Variable Row Values into Variable Column Values Using VBA

Original code link: MS Access - Convert rows values into columns values
I have a follow up to a question where the answer didn't completely resolve, but got super close. It was asked at the original code link above. It's the single page on the net that actually addresses the issue of transposing multiple values in a one-to-many relationship set of columns to a single row for each related value in a dynamic manner specifically using VBA. Variations of this question have been asked about a dozen times on this site and literally none of the answers goes as far as Vlado did (the user that answered), which is what's necessary to resolve this problem.
I took what Vlado posted in that link, adjusted it for my needs, did some basic cleanup, worked through all the trouble-shooting and syntax problems (even removed a variable declared that wasn't used: f As Variant), and found that it works almost all the way. It generates the table with values for the first two columns correctly, iterates the correct number of variable count columns with headers correctly, but fails to populate the values within the cells for each of the related "many-values". So close!
In order to get it to that point, I have to comment-out db.Execute updateSql portion of the Transpose Function; 3rd to last row from the end. If I don't comment that out, it still generates the table, but it throws a Run-Time Error 3144 (Syntax error in UPDATE statement) and only creates the first row and all the correct columns with correct headers (but still no valid values inside the cells). Below is Vlado's code from the link above, but adjusted for my field name needs, and to set variables at the beginning of each of the two Functions defined. The second Function definitely works correctly.
Public Function Transpose()
Dim DestinationCount As Integer, i As Integer
Dim sql As String, insSql As String, fieldsSql As String, updateSql As String, updateSql2 As String
Dim db As DAO.Database, rs As DAO.Recordset, grp As DAO.Recordset
Dim tempTable As String, myTable As String
Dim Var1 As String, Var2 As String, Var3 As String, Var4 As String
tempTable = "Transposed" 'Value for Table to be created with results
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
Var4 = "Dest" 'Value for Column Name Prefixes
DestinationCount = GetMaxDestination
Set db = CurrentDb()
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tempTable & "'")) Then
DoCmd.DeleteObject acTable, tempTable
End If
fieldsSql = ""
sql = "CREATE TABLE " & tempTable & " (" & Var1 & " CHAR," & Var2 & " CHAR "
For i = 1 To DestinationCount
fieldsSql = fieldsSql & ", " & Var4 & "" & i & " INTEGER"
Next i
sql = sql & fieldsSql & ")"
db.Execute (sql)
insSql = "INSERT INTO " & tempTable & " (" & Var1 & ", " & Var2 & ") VALUES ("
Set grp = db.OpenRecordset("SELECT DISTINCT " & Var1 & ", " & Var2 & " FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & "")
grp.MoveFirst
Do While Not grp.EOF
sql = "'" & grp(0) & "','" & grp(1) & "')"
db.Execute insSql & sql
Set rs = db.OpenRecordset("SELECT * FROM " & myTable & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'")
updateSql = "UPDATE " & tempTable & " SET "
updateSql2 = ""
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
updateSql2 = updateSql2 & "" & Var3 & "" & i & " = " & rs(2) & ", " ' <------- MADE CHANGE FROM (3) to (2)
rs.MoveNext
Loop
updateSql = updateSql & Left(updateSql2, Len(updateSql2) - 1) & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'"
db.Execute updateSql ' <-- This is the point of failure
grp.MoveNext
Loop
End Function
Public Function GetMaxDestination()
Dim rst As DAO.Recordset, strSQL As String
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
strSQL = "SELECT MAX(CountOfDestination) FROM (SELECT Count(" & Var3 & ") AS CountOfDestination FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & ")"
Set rst = CurrentDb.OpenRecordset(strSQL)
GetMaxDestination = rst(0)
rst.Close
Set rst = Nothing
End Function
Sample Table:
Sample Data:
Add a Debug.Print updateSql before that Execute line and will see improper syntax in SQL statement. Need to trim trailing comma from updateSql2 string. Code is appending a comma and space but only trims 1 character. Either eliminate space from the concatenation or trim 2 characters.
Left(updateSql2, Len(updateSql2) - 2)
Concatenation for updateSql2 is using Var3 instead of Var4.
Source field is a number type in ConvergeCombined and this triggers a 'type mismatch' error in SELECT statement to open recordset because of apostrophe delimiters Var1 & " = '" & grp(0) & "' - remove them from two SQL statements.
Also, Source value is saved to a text field in Transposed, make it INTEGER instead of CHAR in the CREATE TABLE action.
So with the help of a friend I figured it out. It turns out I needed two Functions because the one-to-many relationships go both directions in my case. I explain below what needs to happen in comments for this to work. Essentially I went with the second comment under the question I posed (pre-defining field names in static tables because there is a limited number of fields that any person will need - it can't exceed 256 fields anyway, but it isn't always practical to use more than a dozen or so fields - this way allows for both and at the same time to simplify the code significantly).
This solution actually works - but it's dependent on having tables (or queries in my situation) labeled ConvergeSend and ConvergeReceive. Also, it's important to note that the instances where the Destination is single and the Source is plural, the table or query (ConvergeSend/ConvergeReceive) must have the Destination value as a column TO THE LEFT of the iterated Source columns. This is also true (but reverse naming convention) for the other table/query (the Source column must be TO THE LEFT of the iterated Destination columns).
' For this code to work, create a table named "TransposedSend" with 8 columns: Source, Destination1, Destination2,...Destination7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeSend()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedSend", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedSend (Source) SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Source, Destination, [Destination App Name] FROM ConvergeSend WHERE Source = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedSend SET Destination" & i & " = '" & rs(1) & "', [Destination" & i & " App Name] = '" & rs(2) & "'" & " WHERE Source = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function
' For this code to work, create a table named "TransposedReceive" with 8 columns: Destination, Source1, Source2,...Source7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeReceive()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedReceive", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedReceive (Destination) SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Destination, Source, [Source App Name] FROM ConvergeReceive WHERE Destination = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedReceive SET Source" & i & " = '" & rs(1) & "', [Source" & i & " App Name] = '" & rs(2) & "'" & " WHERE Destination = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function

Using Input from Worksheet in a Query in a Macro

I am trying to take the percent column, column 3, from the "input" file and use that to take a discount on a price and put that price in the output file, one by one in column 7.
I pass the SQL connection to a function, a UPC value that looks up information in a database, and then the percent value (a Double) as input.
However, I keep getting the error "Incorrect syntax near the keyword percent". I have tried renaming the percent variable, and also using the Val() function (as you can see in the code).
If I take the Val() out, I get a type mismatch error
Basically: I cannot figure out how to use an input for "percent" such as .10 in my Query.
For i = 1 To 381
wrkb.Worksheets("Output").Cells(i + 1, 2).CopyFromRecordset extractInfo(cnn, wrkb.Worksheets("Input").Cells(i, 2).Value, Val(wrkb.Worksheets("Input").Cells(i, 3).Value))
Next i
Function extractInfo(cnn As ADODB.Connection, upc As String, percent As Double) As ADODB.Recordset
'Initializes variables
Dim rst As New ADODB.Recordset
Dim StrQuery As String
'The query to run, feed the UPC value you acquired to then get all the other variables
StrQuery = "SELECT 'N' as Division, zzeupcnr.style as Style, color_code as Color, ' ' as label_code, dimension as Dimension, ROUND((a_price * (1.00 - percent)), 2), ret_price " & _
"FROM zzeupcnr JOIN zzxstylr " & _
"ON zzeupcnr.style = zzxstylr.style " & _
"WHERE upc = '" & upc & "'"
'Performs the actual query
rst.Open StrQuery, cnn
Set extractInfo = rst 'Stores result
You're using percent in your query string as a string.
If you want to use the variable value, you need to do this:
StrQuery = "SELECT 'N' as Division, zzeupcnr.style as Style, color_code as Color, ' ' as label_code, dimension as Dimension, ROUND((a_price * (1.00 - " & percent & ")), 2), ret_price " & _
"FROM zzeupcnr JOIN zzxstylr " & _
"ON zzeupcnr.style = zzxstylr.style " & _
"WHERE upc = '" & upc & "'"
Note the " & percent & "

Access Append Query In VBA From Multiple Sources Into One Table, Access 2010

I hardly ever post for help and try to figure it out on my own, but now I’m stuck. I’m just trying to append data from multiple tables to one table. The source tables are data sets for each American State and the append query is the same for each State, except for a nested select script to pull from each State table. So I want to create a VBA script that references a smaller script for each state, rather than an entire append script for each state. I’m not sure if I should do a SELECT CASE, or FOR TO NEXT or FOR EACH NEXT or DO LOOP or something else.
Here’s what I have so far:
tblLicenses is a table that has the field LicenseState from which I could pull a list of the states.
Function StateScripts()
Dim rst As DAO.Recordset
Dim qryState As String
Dim StateCode As String
Set rst = CurrentDb.OpenRecordset("SELECT LicenseState FROM tblLicenses GROUP BY LicenseState;")
' and I've tried these, but they don't work
' qryState = DLookup("LicenseState", "tblLicenses")
' qryState = "SELECT LicenseState INTO Temp FROM tblLicenses GROUP BY LicenseState;"
' DoCmd.RunSQL qryState
Select Case qryState
Case "CT"
StateCode = "CT"
StateScripts = " SELECT [LICENSE NO] AS StateLicense, [EXPIRATION DATE] AS dateexpired FROM CT "
Case "AK"
StateCode = "AK"
StateScripts = " SELECT [LICENSE] AS StateLicense, [EXPIRATION] AS dateexpired FROM AK "
Case "KS"
StateCode = "KS"
StateScripts = " SELECT [LicenseNum] AS StateLicense, [ExpDate] AS dateexpired FROM KS "
End Select
CurrentDb.Execute " INSERT INTO TEST ( StLicense, OldExpDate, NewExpDate ) " _
& " SELECT State.StateLicense as StLicense, DateExpire AS OldExpDate, State.dateexpired AS NewExpDate " _
& " FROM ( " & StateScripts & " ) AS State " _
& " RIGHT JOIN tblLicenses ON (State.StateLicense = tblLicenses.LicenseNum) " _
& " GROUP BY State.StateLicense, DateExpire, State.dateexpired " _
& " HAVING (((LicenseNum) Like '*" & StateCode & "*') ; "
End Function
It sounds like you are dealing with input sources that use different column names for the same information, and you are working to merge it all into a single table. I will make the assumption that you are dealing with 50 text files that are updated every so often.
Here is one way you could approach this project...
Use VBA to build a collection of file names (using Dir() in a specific folder). Then loop through the collection of file names, doing the following:
Add the file as a linked table using VBA, preserving the column names.
Loop through the columns in the TableDef object and set variables to the actual names of the columns. (See example code below)
Build a simple SQL statement to insert from the linked table into a single tables that lists all current license expiration dates.
Here is some example code on how you might approach this:
Public Sub Example()
Dim dbs As Database
Dim tdf As TableDef
Dim fld As Field
Dim strLic As String
Dim strExp As String
Dim strSQL As String
Set dbs = CurrentDb
Set tdf = dbs.TableDefs("tblLinked")
' Look up field names
For Each fld In tdf.Fields
Select Case fld.Name
Case "LICENSE", "LICENSE NO", "License Num"
strLic = fld.Name
Case "EXPIRATION", "EXPIRATION DATE", "EXP"
strExp = fld.Name
End Select
Next fld
If strLic = "" Or strExp = "" Then
MsgBox "Could not find field"
Stop
Else
' Build SQL to import data
strSQL = "insert into tblCurrent ([State], [License],[Expiration]) " & _
"select [State], [" & strLic & "], [" & strExp & "] from tblLinked"
dbs.Execute strSQL, dbFailOnError
End If
End Sub
Now with your new table that has all the new data combined, you can build your more complex grouping query to produce your final output. I like this approach because I prefer to manage the more complex queries in the visual builder rather than in VBA code.
Thanks for your input. I came up with a variation of your idea:
I created table ("tblStateScripts"), from which the rs!(fields) contained the various column names
Dim rs As DAO.Recordset
Dim DB As Database
Set DB = CurrentDb
Set rs = DB.OpenRecordset("tblStateScripts")
If Not rs.EOF Then
Do
CurrentDb.Execute " INSERT INTO TEST ( StLicense, OldExpDate, NewExpDate ) " _
& " SELECT State.StateLicense as StLicense, DateExpire AS OldExpDate, State.dateexpired AS NewExpDate " _
& " FROM ( SELECT " & rs!FldLicenseState & " AS StateLicense, " & rs!FldExpDate & " AS DateExp " & " FROM " & rs!TblState " _
& " RIGHT JOIN tblLicenses ON (State.StateLicense = tblLicenses.VetLicense) " _
& " GROUP BY State.StateLicense, DateExpire, State.dateexpired " _
& " HAVING (((LicenseNum) Like '*" & rs!StateCode & "*') ; "
rs.MoveNext
Loop Until rs.EOF
End If
rs.Close
Set rs = Nothing

Data-type mismatch Access 2010

We have been creating a HR Database using Access as the back-end and Excel as the front-end. When I run my macro in Excel to insert entries into the MasterTable it says; "Data Type Mismatch". The only field that I had changed was the "Job" Field which required a value between 0.0 - 1.0 (i.e. 0.2 means they are only working one day).
Previously when I inserted entries in the decimal place would not show until I changed the field type in Access to accept decimals. After this change, the macro no longer works.
Can anyone point out why this is?
I have only just started learning SQL/Access so it is very likely I made a very basic mistake.
I searched up on SO a few other answers which talked about using the DECIMAL field instead of changing the properties field but this didn't solve my issue. My code:
Sub ExportDataToAccess()
Dim cn As Object
Dim strQuery As String
Dim Id As String
Dim Positions As String
Dim BU As String
Dim Job As Double
Dim Variance As String
Dim myDB As String
'Initialize Variables
Id = Worksheets("test").Range("A2").Value
Positions = Worksheets("test").Range("B2").Value
BU = Worksheets("test").Range("C2").Value
Job = Worksheets("test").Range("D2").Value
myDB = "X:\Users\ADMIN\Documents\HR_Establishment_DB1.accdb"
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0" 'For *.ACCDB Databases
.ConnectionString = myDB 'Connects to my DB
.Open
End With
strQuery = "INSERT INTO MasterTable ([Id], [Positions], [BU], [Job]) " & _
"VALUES (""" & Id & """, """ & Positions & """, """ & BU & """, " & Job & "); "
cn.Execute strQuery
cn.Close
Set cn = Nothing
End Sub
Do you intend the value of ID to be obtained from the excel (Id = Worksheets("test").Range("A2").Value)?
I think it is causing the error. If a field on access is of AutoNumber data type, you don't have to include it on your INSERT query as access automatically assigns a value for this in incremental manner.
If you want access to automatically assign a value for ID, change this:
strQuery = "INSERT INTO MasterTable ([Id], [Positions], [BU], [Job]) " & _
"VALUES (""" & Id & """, """ & Positions & """, """ & BU & """, " & Job & "); "
to this:
strQuery = "INSERT INTO MasterTable ([Positions], [BU], [Job]) " & _
"VALUES (""" & Positions & """, """ & BU & """, " & Job & "); "

Concatenating Multiple columns in an Access table to one specific row

I have been on the web searching for answers and I just can not find one that works (I'm sure it is something I am not doing right)
I have a table in Access called TBL003_Combined Data that has the following columns:
UPLOADED, REF ID, QTY, PART NUMBER, ITEM DESCRIPTION, SHIP TO
4/8/2015, 123, 20, 9125xtr, sample item, XYZ Company, 789 Address Lane, Somewhere,US 159632
4/8/2015, 123, 16, 22578xtz, sample item2, XYZ Company, 789 Address Lane, Somewhere,US 159632
4/8/2015, 123, 8, 7758rty, sample item3, XYZ Company, 789 Address Lane, Somewhere,US 159632
What I am trying to do is for each unique [REF ID], I want to concatenate the QTY, [PART NUMBER], [ITEM DESCRIPTION] & [SHIP TO] to a new column called [CS_ITEM DESCRIPTION].
I have tried the following in Allen Brown's site:
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSQL As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null
ConcatRelated = Null
'Build SQL string, and get the records.
strSQL = "SELECT DISTINCT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSQL = strSQL & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSQL = strSQL & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
and my query I've used the following:
SELECT DISTINCT
[REF ID],
ConcatRelated("[QTY],[PART NUMBER], [ITEM DESCRIPTION], [SHIP TO]",
"[TBL003_Combined Data]",
"[REF ID] = " & [REF ID],
"("[QTY],[PART NUMBER], [ITEM DESCRIPTION], [SHIP TO]",
"/"
) AS CS_ITEM DESCRIPTIONS
FROM [TBL003_Combined Data];
and I keep getting the following error:
"Syntax error (missing operator) in query expression...."
then it list the entire SQL I'm referencing above (Select Distinct). Any help in pointing me in the right direction or advising why I am doing wrong (as I'm certain it's me) will be greatly appreciated.
added: The result I'm trying to reach is for the data to come out as follows:
UPLOADED, REF ID, CS_ITEM DESCRIPTION
4/8/2015, 123, 20 / 9125xtr / sample item / 16 / 22578xtz /sample item2 / 8 / 7758rty / sample item3 / XYZ Company, 789 Address Lane, Somewhere,US 159632
Try this:
SELECT distinct [REF ID],
[QTY] + ' ' + [PART NUMBER] + ' ' + [ITEM DESCRIPTION] + ' ' + [SHIP TO]
AS 'CS_ITEM DESCRIPTIONS'
FROM [TBL003_Combined Data];