I am writing a script that filters a query based off user input, then data in this query will be used to make a new table qryMyExportedData. From there, the data will be exported to ExportedData.xlsx. When I attempt to run my code, I get the following error:
Run-time error '2498': An expression you entered is the wrong data type for one of the arguments.
My code:
Private Sub Query_Click()
Dim strExport as String
strExport = "SELECT * FROM qryCostDepLosses WHERE [Maintenance Type] = '" & Me.MainType & "' AND [Date] = #" & Me.Date & "#"
Set qdfNew = CurrentDb.CreateQueryDef("myExportQueryDef", strExport)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "myExportQueryDef", CurrentProject.Path & "\ExportedData.xlsx", "True"
CurrentDb.QueryDefs.Delete qdfNew.Name 'cleanup
End Sub
I have narrowed down the error to the DoCmd.TransferSpreadsheet line. The strExport looks as it should, I believe. The data is exported to myExportQueryDef as well.
Your are attempting to send a Boolean as a String. So the code should look like this:
Private Sub Query_Click()
Dim strExport as String
strExport = "SELECT * FROM qryCostDepLosses WHERE [Maintenance Type] = '" & Me.MainType & "' AND [Date] = #" & Me.Date & "#"
Set qdfNew = CurrentDb.CreateQueryDef("myExportQueryDef", strExport)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "myExportQueryDef", CurrentProject.Path & "\ExportedData.xlsx", True
CurrentDb.QueryDefs.Delete qdfNew.Name 'cleanup
End Sub
Basically just remove the quotes from around True.
Related
I am trying to match excel files which is placed in a folder with tables which exist in access database (with the same name as my excel files) and trying to import data which is in excel to access.
Sub import()
Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String
blnHasFieldNames = True
strPath = "D:\PersonalData\working_table\"
strWorksheet = "Sheet1"
' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xlsx")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
strTable = Left(strFile, InStrRev(strFile, ".xlsx") - 1)
DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel9, strTable, strPathFile, _
blnHasFieldNames, strWorksheet & "$"
DoCmd.RunSQL ("DELETE * FROM " & strTable & " WHERE SPEC_ID = 'Specification ID'")
strFile = Dir()
Loop
End Sub
I am successfully able to get the data into my access database tables, however my requirement is to delete the row from all such tables where SPEC_ID = 'Specification ID' . I am getting an error in line:
DoCmd.RunSQL ("DELETE * FROM " & strTable & " WHERE SPEC_ID = 'Specification ID'")
which states:
Run-time error: '3131'
Syntax error in FROM clause.
Kindly guide me what I may have been doing wrong.
Thanks in advance.
Using DoCmd.SetWarnings is a recipe for trouble. What if there is an error in the sql and your code exits without setting the warnings back to true? All sorts of weird stuff happens. Instead use the simpler and just as easy
CurrentDb.Execute "DELETE * FROM [" & strTable & "] WHERE SPEC_ID = 'Specification ID'"
You'll still need to check that strTable doesn't have [ or ] in the name (otherwise the bracketing won't be effective) and you'll need to either remove them or escape them (depending on how your actual table is named).
do like this
Docmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM [" & strTable & "] WHERE SPEC_ID = 'Specification ID'")
Docmd.SetWarnings True
I am trying to write the user name who is currently logged in to records in the table X that is used to update table Y with new records from it.
Here is the code I use:
Private Sub UPD_Click()
On Error GoTo Err_UPD_Click
DoCmd.TransferDatabase acImport, "Microsoft Access", "D:\Working\Test.mdb", acTable, "tblTest", "tblTest_Import", False
DoCmd.RunSQL "ALTER TABLE tblTest_Import ADD COLUMN [CreatedBy] Text(25);"
Dim myDB As Database
Set myDB = CurrentDb
myDB.Execute "UPDATE tblTest_Import " _
& "SET [tblTest_Import].[CreatedBy] = [Forms]![frmLogin]![txtUserName];"
myDB.Execute "INSERT INTO tblMain(Year, CreatedBy)"_
& "SELECT tblTest_Import.Year, tblTest_Import.CreatedBy " _
& "FROM tblTest_Import " _
& "WHERE (((Exists (SELECT * FROM tblMain " _
& "WHERE tblMain.ID = tblTest_Import.ID))=False));"
Exit_UPD_Click:
Exit Sub
Err_UPD_Click:
MsgBox Err.Description
Resume Exit_UPD_Click
End Sub
Form frmLogin stays open but hidden (Me.Visible = False).
The problem is the field CreatedBy in tblTest_Import does not get updates and Access returns this message: "Too few parameters. Expected 1." And none of lines in the code gets highlighted.
I tried to add
Dim frmLogin As Form
Set frmLogin = Screen.ActiveForm
but it didn't help.
What is wrong with my code?
I found solution :)
I just needed to add several quotes to this part of code
myDB.Execute "UPDATE tblTest_Import " _
& "SET [tblTest_Import].[CreatedBy] = '" & [Forms]![frmLogin]![UserName] & "';"
Bingo!
I'm trying to export the results of a dynamic SQL statement but keep getting the error 3027 "Cannot update. Database or object is read-only.". I'm using Access 2003. GetYearFromDirName(sFolder) is parsing out a year from a directory structure and using that as a calculated column in the SQL results.
Here is the code in question:
sSQL = "SELECT INDEXDB1.IFIELD1 AS TestArea, INDEXDB1.IFIELD2 AS TSID, INDEXDB1.IFIELD3 AS MapCoord, " _
& "INDEXDB1.IFIELD4 AS Community, INDEXDB1.IFIELD5 AS Address, INDEXDB1.IFIELD6 AS DocNum, " _
& "'" & GetYearFromDirName(sFolder) & "' AS Yr FROM INDEXDB1;"
'DoCmd.TransferSpreadsheet acExport, , sSQL, sFolder & "\" & BoxNum & ".csv"
'DoCmd.OutputTo acOutputQuery, "ExportRecs", acFormatXLS, sFolder & "\" & BoxNum & ".csv"
SaveToExcel sSQL, sFolder & "\" & BoxNum & ".csv"
Calls:
Public Sub SaveToExcel(strSQL As String, strFullFileName As String)
Dim strQry As String
Dim db As Database
Dim Qdf As QueryDef
On Error GoTo SaveToExcel_err
strQry = "TempQueryName"
Set db = CurrentDb
'Set Qdf = db.CreateQueryDef(strQry, strSQL)
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strQry, strFullFileName, True
'DoCmd.DeleteObject acQuery, strQry
With db
' Create permanent QueryDef.
Set Qdf = .CreateQueryDef(strQry, strSQL)
' Open Recordset and print report.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel3, strQry, strFullFileName, True
' Delete new QueryDef because this is a demonstration.
.QueryDefs.Delete Qdf.Name
.Close
End With
Exit Sub
SaveToExcel_err:
MsgBox Error & " " & Err & " in sub SaveToExcel. Close program and start over."
End Sub
Is there a better way to export dynamic SQL statement results? In the end, I need a CSV file.
You may open it in Excel, but CSV is a text format, so you need to use DoCmd.TransferText instead of DoCmd.TransferSpreadsheet. Manually go through the export once using the Export Data Wizard. As you do so, you'll wand to create and name a Export Specification. This will specify commas as the delimiter and double quotes as text delimiters. The name of the export spec you created is passed as the second argument to TransferText.
I'm making a very basic data entry and database system application using excel (for bulk data entry) and Access (to house the data). I play to distribute it as a zip file. In order for it to work I need the file structure to remain unchanged and to unzip to c:/ drive. Is there anyway to force a zip file to unzip to a specific location?
The reason I need this is to automate the uploading of entered data. As far as I know in Access VBA you have to specify full filepaths in VBA to import data.
* Update
Thanks to Remou for getting me out of the woods. Just for posterity's sake this is how I solved it. not the prettiest code but it does the job. First the import function and then the export function.
Importing, a naming convention is still need for the files being uploaded but they can come from anywhere. That file name relates to the tables they will be stored in. At the back end of the excel sheets the data input sheet is split into two (Rec and Occ)
Code as follows:
Function importData_Click(Optional varDirectory As String, _
Optional varTitleForDialog As String) As String
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As String
Dim strFileName As String
Dim strTableName As String
Dim strColumnName As String
Dim The_Year As Long
Dim occNumber As Long
'Get combobox value and assign relavent values to occNumber
The_Year = Forms![Upload Data]!Year_Combo.value
'Ask the to check value
If MsgBox("Uploading " & The_Year & " data" & vbCrLf & "Continue?", VbMsgBoxStyle.vbYesNo) = 7 Then
Exit Function
End If
If The_Year = 2012 Then
occNumber = 1000
ElseIf The_Year = 2013 Then
occNumber = 2000
End If
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If
strFilter = ahtAddFilterItem("Excel Files (*.xlsx)", "*.xlsx")
varFileName = ahtCommonFileOpenSave( _
openFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
importData_Click = varFileName
'Sets filename
strFileName = Dir(varFileName)
'Sets TableName
strTableName = Left(strFileName, 4)
If IsNull(strFileName) Then
MsgBox "Upload cancelled"
Exit Function
End If
'Checks naming convetions of filenames
If strTableName Like "*MN" Or strTableName Like "*OP" Or strTableName Like "*DA" Or strTableName Like "*TR" Then
'Checks if data is Opportunistic
If strTableName Like "*OP" Then
strColumnName = "Year_" & strTableName
'Checks to see if that year's data already exists
If DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & The_Year & "") Then
MsgBox "2012 data is already present"
ElseIf DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & The_Year & "") Then
MsgBox "2013 data is already present"
Else
'Uploads data to relevant table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Rec", varFileName, True, "Rec_Prep$"
MsgBox "Upload successful"
End If
Exit Function
Else
strColumnName = "Occasion_" & strTableName
'Checks Occasions to see if that year exists
If DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & occNumber & "") Then
MsgBox "2012 data is already present"
ElseIf DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & occNumber & "") Then
MsgBox "2013 data is already present"
Else
'Uploads to Records table and Occasion table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Occ", varFileName, True, "Occ_Prep$"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Rec", varFileName, True, "Rec_Prep$"
MsgBox "Upload successful"
End If
End If
Else
MsgBox "Your file is named incorrectly! & vbCrLf & Please refer to the Data Dictionary & vbCrLf & for correct naming conventions"
Exit Function
End If
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "BaMN_AllData", strSaveFileName
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
Then the export uses the names of command buttons (that match table names) to export to wherever the user wants:
Dim queryYear As Variant
'Function to export data to location of users choice. Query name is automatically detected from the control button used
'Year is derived from the combobox value on [Extract Data] form, null value defaults to all years.
Function exportData_Click()
Dim strFilter As String
Dim strSaveFileName As String
Dim The_Year As Variant
Dim ctlCurrentControl As Control
Dim queryName As String
'Get the name of the control button clicked (corresponds to query name to be run)
Set ctlCurrentControl = Screen.ActiveControl
queryName = ctlCurrentControl.Name
'Get combobox value and assign relavent values to The_Year
The_Year = Forms![Extract Data]!Extract_Year.value
'Change the year from a variant to what we need in the SQL
If The_Year Like "20*" Then
The_Year = CInt(The_Year)
MsgBox The_Year & "Data Type = " & VarType(The_Year)
Else: The_Year = "*"
MsgBox The_Year & "Data Type = " & VarType(The_Year)
End If
'Set queryYear variable
setYear (The_Year)
'Check the variable is correct
'MsgBox getYear()
'Open the Save as Dialog to choose location of query save
strFilter = ahtAddFilterItem("Excel Files (*.xlsx)", "*.xlsx")
strSaveFileName = ahtCommonFileOpenSave( _
openFile:=False, _
Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, queryName, strSaveFileName
End Function
'Function to set queryYear used in data extraction queries
Public Function setYear(The_Year As Variant)
queryYear = The_Year
End Function
'Function to get queryYear used in data extraction queries
Function getYear()
getYear = queryYear
End Function
It should be noted that the file save and file open code sections are not mine. They come from Ken Getz and the whole code can be found here:
http://access.mvps.org/access/api/api0001.htm
It would be better to use the application path ( eg currentproject.Path ) or to ask the user to specify a location for the data store rather than to try to force an install at a location that may not be available to the user. There is no need at all to hard-code paths. In Access, you can store information relevant to the project in a table, including the data path. You can look up MS Access from Excel.
I've been looking a while now for a solution to export a query with open parameters. I need to export a Query as a Formatted Excel Spreadsheet and can't create additional Tables, Queries, Forms, or Reports to the Database being used. I use DoCmd.OutputTo as it exports a formatted query unlike DoCmd.TransferSpreadsheet however I can't seem to export the query with defined parameters. I need to include the parameters or else the user will be forced to input the start and end date three times a piece as the database for some reason asks for the startDate and endDate twice and in order to keep the excel spreadsheet and the subsequent outlook section consistant i would have to ask the user to input their previous parameters again
Sub Main()
On Error GoTo Main_Err
'Visually Display Process
DoCmd.Hourglass True
Dim fpath As String
Dim tname As String
Dim cname As String
Dim tType As AcOutputObjectType
Dim tempB As Boolean
fpath = CurrentProject.path & "\"
'tType = acOutputTable
'tname = "APPROVED SWPS FOR LOOK AHEAD & BAR CHART"
tType = acOutputQuery
tname = "ASFLA&BC Query"
cname = "Temp BPC Calendar"
Dim qdfQry As DAO.QueryDef
Dim strStart As String
Dim strEnd As String
Set qdfQry = CurrentDb().QueryDefs(tname)
'strStart = InputBox("Please enter Start date (mm/dd/yyyy)")
'strEnd = InputBox("Please enter Start date (mm/dd/yyyy)")
qdfQry.Parameters("ENTER START DATE") = FormatDateTime("6/30/12", vbShortDate) 'strEnd
qdfQry.Parameters("ENTER END DATE") = FormatDateTime("7/1/12", vbShortDate) 'strStart
tempB = Backup(fpath, qdfQry, tType)
If (Not tempB) Then
MsgBox "Excel Conversion Ended Prematurely..."
Exit Sub
End If
' tempB = sendToOutlook(qdfQry, cname)
' If (Not tempB) Then
' MsgBox "Access Conversion Ended Prematurely..."
' Exit Sub
' End If
MsgBox "Procedure Completed Successfully"
Main_Exit:
DoCmd.Hourglass False
Exit Sub
Main_Err:
DoCmd.Beep
MsgBox Error$
Resume Main_Exit
End Sub
'************************************************************************************
'*
'* Excel PORTION
'*
'************************************************************************************
Public Function Backup(path As String, db As DAO.QueryDef, Optional outputType As AcOutputObjectType) As Boolean
On Error GoTo Error_Handler
Backup = False
Dim outputFileName As String
Dim name As String
Dim tempB As Boolean
'Set Up All Name Variablesand
name = Format(Date, "MM-dd-yy") & ".xls"
'Cleans Directory of Any older files and places them in an archive
SearchDirectory path, "??-??-??.xls", name
'See If File Can Now Be Exported. If Already Exists ask to overwrite
outputFileName = path & name
tempB = OverWriteRequest(outputFileName)
If tempB Then
'Formats The Table And Exports Into A Formatted SpreadSheet
'Checks if an output type was added to the parameter if not defualt to table
If Not IsMissing(outputType) Then
DoCmd.OutputTo outputType, db.name, acFormatXLS, outputFileName, False
Else
DoCmd.OutputTo acOutputTable, db.name, acFormatXLS, outputFileName, False
End If
Else
Exit Function
End If
Backup = True
Error_Handler_Exit:
Exit Function
Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.number & vbCrLf & "Error Source: Main Excel Backup" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
The SQL currently given looks like similar to below with omitted fields for for clarity
PARAMETERS [ENTER START DATE] DateTime, [ENTER END DATE] DateTime;
SELECT [SWPS].STATION,
[SWPS].START_DATE,
[SWPS].END_DATE,
FROM [SWPS]
WHERE ((([SWPS].STATION)
Like ("*"))
AND (([SWPS].START_DATE)<=[ENTER END DATE])
AND (([SWPS].END_DATE)>=[ENTER START DATE])
AND (([SWPS].SWP_STATUS) In ("A","P","W","T","R")));
I suggest you change the sql of the query.
Dim qdfQry As DAO.QueryDef
Dim strStart As String
Dim strEnd As String
''You could use a query specifically for this
Set qdfQry = CurrentDb.QueryDefs(tname)
sSQL=qdfQry.SQL
NewSQL = "SELECT [SWPS].STATION, [SWPS].START_DATE, [SWPS].END_DATE, " _
& "FROM [SWPS] WHERE [SWPS].STATION Like '*' " _
& "AND [SWPS].SWP_STATUS In ('A','P','W','T','R') " _
& "AND [SWPS].START_DATE)<=#" & Format(DateStart, "yyyy/mm/dd") & "# " _
& "AND [SWPS].END_DATE)>=#" & Format(DateEnd, "yyyy/mm/dd") & "#"
qdfQry.SQL = NewSQL
''Do the excel stuff
''Reset the query
qdfQry.SQL = sSQL