I'm trying to update a date/time field when a new file is imported through vba.
It works for the first file, but for subsequent imports I get a type mismatch error.
If I delete the 'FileDate' field and re-insert it, it works for the first time, but after I get the error again.
Dim db As DAO.Database
Dim str_table As String
Dim str_sql As String
Dim dt As Date
str_table = "Items"
dt = CDate(Format(FileDateFromPath(file_path), "MM/DD/YYYY"))
Set db = CurrentDb()
str_sql = "UPDATE [" & str_table & "] SET [FileDate] = #" & dt & "# " & _
"WHERE [FileDate] Is Null OR [FileDate]='';"
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=str_table, _
FileName:=file_path, _
HasFieldNames:=True ' or False if no headers
db.Execute str_sql, dbFailOnError '<-- error here's
I've tried different formats for the date (DD/MM/YYYY, changed to MM/DD/YYYY), I've included # around the date...
Deleting the field and re-inserting it works, but only for the first time...
Is there something I'm missing?
Your dt variable is a Date, not a String. Therefore the Format you apply has no effect, and when you concat the variable, it will use your local date format.
Use Gustav's CSql() function when concatenating variables with SQL.
Also, a date column can not have the value '', so you can omit that.
str_sql = "UPDATE [" & str_table & "] SET [FileDate] = " & CSql(dt) & _
" WHERE [FileDate] Is Null;"
should work.
Related
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
I have a table in excel that has multiple lines per date. I'd like to create a new table that groups by date as well as a few other dimensions and sums net_revenue.
In sql it would be simple:
SELECT send_date,
week_day,
after_hours,
discount_type,
sum(net_revenue
FROM this_table
GROUP BY send_date,
week_day,
after_hours,
discount_type
Is there a simple way to do this in excel? At first I thought pivot tables but I don't want each additional dimension on a new row.
This is what my current table looks like:
Consider the following strictly GUI interface solution:
Copy all your grouping fields as is into a separate sheet.
Under Data tab of ribbon, click Remove Duplicates, selecting all columns.
In the final column, run SUMIFS formula to calculate net_revenue sum, pointing to values in you original sheet.
=SUMIFS(<net_revenue_column>,
<1stgroup_column_in_first_sheet>, <1stgroup_value_in_second_sheet>,
<2ndgroup_column_in_first_sheet>, <2ndgroup_value_in_second_sheet>,
<3rdgroup_column_in_first_sheet>, <3rdgroup_value_in_second_sheet>,
...
)
Alternatively, actually run SQL (if using Excel for Windows) using the JET/ACE SQL Engine (same engine of MS Access that can query Excel workbooks even CSV files). Below assumes your data begins in A1 with named columns. Adjust sheet name in FROM clause.
Sub RunSQL()
Dim oConn, rs As Object
Dim strConnection, strSQL As String
Dim i As Integer
Set oConn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
' CONNECTION STRING ON CURRENT WORKBOOK
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
& "DBQ=" & ThisWorkbook.FullName & ";"
' OPEN DB CONNECTION
oConn.Open strConnection
strSQL = "SELECT send_date, " _
& " week_day, " _
& " after_hours, " _
& " discount_type, " _
& " sum(net_revenue) AS total_revenue " _
& " FROM [SheetName$] " _
& " GROUP BY send_date, " _
& " week_day, " _
& " after_hours, " _
& " discount_type "
' OPEN RECORDSET OF QUERY
rs.Open strSQL, oConn
' OUTPUT DATA TO EXCEL WORKSHEET (IN EMPTY TAB NAMED "RESULTS")
' HEADERS
For i = 0 To rs.Fields.Count - 1
ThisWorkbook.Worksheets("RESULTS").Cells(1, i) = rs.Fields(i).Name
Next i
' ROWS
ThisWorkbook.Worksheets("RESULTS").Range("A2").CopyFromRecordset rs
rs.Close: oConn.Close
Set rs = Nothing: Set oConn = Nothing
End Sub
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
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 & "); "
In VBA for Access 2010 and I am just trying to insert some data into a subform. I have a form, with 3 subforms on it. I have 3 unbound text boxes that the user will enter data, hit a command button, and then that data will instert into the subform I have on the layout. Here is my code:
Private Sub cmdAssign_Click()
CurrentDb.Execute " INSERT INTO Crew " _
& "(txtCrewName,txtKitNumber,txtActionDate) VALUES " _
& "(txtAssignCrew, txtAssignKit, txtAssignDate);"
End Sub
I know it has got to be something simple but I'm not really familiar with this. The txtCrewName, txtKitNumber, and txtActionDate are the empty values in the subform where I want data to go. And the txtAssignCrew, txtAssignKit, and txtAssignDate are the unbounds on the form, but outside of the subform 'Crew'. Any ideas? Thanks
EDIT: Figured it out. Thank you all for the help
So txtAssignCrew, txtAssignKit, and txtAssignDate are the names of controls on the form. The db engine doesn't know what they are, so assumes they must be parameters.
You could build those controls' values (instead of the controls' names) into your INSERT statement. But consider an actual parameter query instead, and execute it from a QueryDef object.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strInsert As String
strInsert = "PARAMETERS crew_name Text(255), kit_num Long, action_date DateTime;" & vbCrLf & _
"INSERT INTO Crew (txtCrewName,txtKitNumber,txtActionDate)" & vbCrLf & _
"VALUES (crew_name, kit_num, action_date);"
Debug.Print "strInsert:" & vbCrLf & strInsert
Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strInsert)
qdf.Parameters("crew_name") = Me.txtAssignCrew
qdf.Parameters("kit_num") = Me.txtAssignKit
qdf.Parameters("action_date") = Me.txtAssignDate
qdf.Execute dbFailOnError
Set qdf = Nothing
Set db = Nothing
Note, in the PARAMETERS clause I assumed text as the data type for txtCrewName, long integer for txtKitNumber, and Date/Time for txtActionDate. If all are text, adjust the PARAMETERS clause.
This should work, assuming txtAssignCrew, Kit, and Date are your unbound controls you want to insert. Realize that if there are single quotes or anything in those fields, it would cause the statement to fail, so you would need to escape them.
Private Sub cmdAssign_Click()
CurrentDb.Execute " INSERT INTO Crew " _
& "(txtCrewName,txtKitNumber,txtActionDate) VALUES " _
& "('" & me.txtAssignCrew & "', '" & me.txtAssignKit & "','" & me.txtAssignDate & ");"
End Sub
I may have botched a quote.
Corrected code:
CurrentDb.Execute " INSERT INTO Crew " _
& "(txtCrewName,txtKitNumber,txtActionDate) VALUES " _
& "('" & txtAssignCrew & "','" & txtAssignKit & "','" & txtAssignDate & ");"
Notes:
- You might need to change the format for the AssignDate parameter
- Column names in the database are usually not prefixed with txt
- You would be better off using parametized queries to avoid SQL injection attacks