I have a button that lets me select a file to choose, that location of the file gets saved to a textbox, I use the location from the textbox to upload a file to a data base and I get an error.
"An INSERT INTO query cannot contain a multi-valued field."
Following is my code.
Private Sub btn_Browse_Click()
Dim f As Object
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant
Set f = Application.FileDialog(3)
f.allowMultiSelect = True
If f.Show Then
For Each varItem In f.selectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
MsgBox "Folder: " & strFolder & vbCrLf & _
"File: " & strFile
Me.txt_PicSource = strFolder + strFile
Next
End If
Set f = Nothing
...
CurrentDb.Execute _
"INSERT INTO Field_Return_Table(Date_FRL, Time_FRL, Client_FRL, Product_FRL, LOT_FRL, Territory_FRL, Tracking_FRL, Condition_FRL, Location_FRL, Completed_By_FRL, Comments_FRL, Attachment_FRL) " & _
"VALUES ('" & strDate & "', '" & strDate & "', '" & Me.combo_Client.Value & "', '" & Me.txt_Product.Value & "', '" & Me.txt_Lot.Value & "', '" & Me.txt_Territory.Value & "', '" & Me.txt_Track.Value & "', '" & strCondition & "', '" & strLocation & "', '" & strUser & "', '" & Me.txt_Comment.Value & "', '" & Me.txt_PicSource.Value & "')"
...
Any tips of how to upload this file via the INSERT INTO?
Related
I am facing a little issue now. My issue is that currently when i made edit to the current record in my subform and click on "update" it will overwrite my previous record which i do not want.
Instead, I would like to add my edited data record from the subform and insert it into the subform as a new record with the same PO number as the one that i am editing.
Below are my code:
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtID.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO mxd " & _
"(ID,Fabrication,Width,FinishedGoods,Colour, " & _
"LabDipCode,GrossWeight,NettWeight, " & _
"Lbs,Loss,Yds,Remarks,POType,ComboName,GroundColour)" & _
" VALUES(" & Me.txtID & ",'" & Me.txtFabrication & "','" & _
Me.txtWidth & "','" & Me.txtFinishedGood & "','" & _
Me.txtColour & "','" & Me.txtLabDipCode & "','" & _
Me.txtGrossweight & "','" & _ Me.txtNettweight & "','" & _
Me.txtLbs & "','" & Me.txtLoss & "','" & _ Me.txtYds & "','" & _
Me.txtRemarks & "','" & Me.cboPoType "','" & _
Me.txtGroundColour & "','" & Me.txtComboName & "')"
Else
'otherwise (Tag of txtID store the id of student to be modified)
CurrentDb.Execute "UPDATE mxd " & _
" SET ID = " & Me.txtID & _
", Fabrication = '" & Me.txtFabrication & "'" & _
", Width = '" & Me.txtWidth & "'" & _
", FinishedGoods = '" & Me.txtFinishedGood & "'" & _
", Colour = '" & Me.txtColour & "'" & _
", LabDipCode = '" & Me.txtLabDipCode & "'" & _
", GrossWeight = '" & Me.txtGrossweight & "'" & _
", NettWeight = '" & Me.txtNettweight & "'" & _
", LBS = '" & Me.txtLbs & "'" & _
", Loss = '" & Me.txtLoss & "'" & _
", Yds = '" & Me.txtYds & "'" & _
", Remarks = '" & Me.txtRemarks & "'" & _
", POType = '" & Me.cboPoType & "'" & _
", ComboName = '" & Me.txtComboName & "'" & _
", GroundColour = '" & Me.txtGroundColour & "'" & _
" WHERE ID = " & Me.txtID.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
FormMxdSub.Form.Requery
End Sub
Private Sub cmdClear_Click()
Me.txtID = ""
Me.txtFabrication = ""
Me.txtWidth = ""
Me.txtFinishedGood = ""
Me.txtColour = ""
Me.txtLabDipCode = ""
Me.txtGrossweight = ""
Me.txtNettweight = ""
Me.txtLbs = ""
Me.txtLoss = ""
Me.txtYds = ""
Me.txtRemarks = ""
Me.cboPoType = ""
Me.txtKeywords = ""
Me.txtComboName = ""
Me.txtGroundColour = ""
'focus on ID text box
Me.txtID.SetFocus
'set button edit to enable
Me.cmdEdit.Enabled = True
'change caption of button add to Add
Me.cmdAdd.Caption = "Add"
'clear tag on txtID for reset new
Me.txtID.Tag = ""
End Sub
Private Sub cmdClose_Click()
DoCmd.Close
End Sub
Private Sub cmdDelete_Click()
'delete record
'check existing selected record
If Not (Me.FormMxdSub.Form.Recordset.EOF And
Me.FormMxdSub.Form.Recordset.BOF) Then
'confirm delete
If MsgBox("Are you sure you want to delete?", vbYesNo) = vbYes Then
'delete now
CurrentDb.Execute "DELETE FROM mxd " & _
"where ID = " & Me.FormMxdSub.Form.Recordset.Fields("ID")
'refresh data in list
Me.FormMxdSub.Form.Requery
End If
End If
End Sub
Private Sub cmdEdit_Click()
'check whether there is exists data in list
If Not (Me.FormMxdSub.Form.Recordset.EOF And
Me.FormMxdSub.Form.Recordset.BOF) Then
'get data to text box control
With Me.FormMxdSub.Form.Recordset
Me.txtID = .Fields("ID")
Me.txtFabrication = .Fields("Fabrication")
Me.txtWidth = .Fields("Width")
Me.txtFinishedGood = .Fields("FinishedGoods")
Me.txtColour = .Fields("Colour")
Me.txtLabDipCode = .Fields("LabDipCode")
Me.txtGrossweight = .Fields("GrossWeight")
Me.txtNettweight = .Fields("NettWeight")
Me.txtLbs = .Fields("Lbs")
Me.txtLoss = .Fields("Loss")
Me.txtYds = .Fields("Yds")
Me.txtRemarks = .Fields("Remarks")
Me.cboPoType = .Fields("POType")
Me.txtComboName = .Fields("ComboName")
Me.txtGroundColour = .Fields("GroundColour")
'store id of student in Tag of txtID in case id is modified
Me.txtID.Tag = .Fields("ID")
'change caption of button add to update
'Me.cmdAdd.Caption = "Update"
'disable button edit
Me.cmdEdit.Enabled = False
End With
End If
End Sub
You can use the RecordsetClone to create a dupe of the current record. Much faster and cleaner and no Tag is needed:
Private Sub btnCopy_Click()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
If Me.NewRecord = True Then Exit Sub
Set rstInsert = Me.RecordsetClone
Set rstSource = rstInsert.Clone
With rstSource
If .RecordCount > 0 Then
' Go to the current record.
.Bookmark = Me.Bookmark
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "SomeFieldToExclude" Then
' Leave field blank.
ElseIf .Name = "SomeOtherFieldToExclude" Then
' Leave field blank.
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
' Go to the new record and sync form.
.MoveLast
Me.Bookmark = .Bookmark
.Close
End With
End If
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub
Of course, if you place the button on the main form, replace in the code Me with a reference to the subform: Me!NameOfYourSubformControl.Form
I have 3 combobox to filter data, then i want to open in command button to print preview..
Problems I have if i used 2 combobox it works but when i used three combobox the report is blank...there's any problems with the code?? here's the code i used :
Dim strWhereCondition As String
strWhereCondition = "[month] = '" & Me.cbmonth.Value _
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Debug.Print strWhereCondition
DoCmd.OpenReport "Month List", View:=acViewPreview, _
WhereCondition:=strWhereCondition
and the requery for my form
SELECT *
FROM MyTable
WHERE (month = Forms!nameForm!cbmonth
OR Forms!MeForm!cbwork IS NULL)
And (works = Forms!nameForm!cbwork
OR Forms!nameForm!cbwork IS NULL)
AND (works = Forms!nameForm!cbwork2
OR Forms!nameForm!cbwork2 IS NULL);
can anyone help?
Month is a number, so try:
strWhereCondition = "[month] = " & Me.cbmonth.Value _
& " and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Edit: Month is text.
However, [Work] is supposed to match two potentially different values:
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Should most likely be:
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [SomeOtherField] = '" & Me.cbwork2.Value & "'"
I am trying to run an Excel macro that imports data from a csv file into an Access database, MySQL front end. The macro code is not new-we've been using this for a couple of years, the table in the Access DB is not new, and the csv files with which the data is used to be brought into the Access table is also unchanged (meaning same rows, same data types).
I am stumped as the error appears to be something of an anomaly and I have tried several fixes to correct the error. I have attached a copy of the error as well as the code below. The issue with the column referenced below as well error message attached, "itemcode", this column is in the database.
Clearly, there is something that I am missing. Any insights are greatly appreciated. Thank you.
'Read in Current .csv file
'Data Services
NumRows = Application.CountA(Range("A:A"))
For iCount = 1 To NumRows
Dim InstData(11)
InstData(1) = Range("A" & iCount) 'Date
invoiceDate = Format(InstData(1), "yyyy/mm/dd")
InstData(2) = Range("B" & iCount) 'Invoice Number
InstData(3) = Range("C" & iCount) 'names
flname() = Split(InstData(3), ",")
lname = flname(0)
fname = flname(1)
InstData(4) = Range("D" & iCount) 'Address1
InstData(5) = Range("E" & iCount) 'Address2
InstData(6) = Range("F" & iCount) 'City
InstData(7) = Range("G" & iCount) 'State
InstData(8) = Format(Range("H" & iCount), "00000") 'postal code
InstData(9) = Range("I" & iCount) 'phone
InstData(10) = Range("J" & iCount) 'email
InstData(11) = Range("K" & iCount) 'amount
Set conn = New ADODB.Connection
Set rec = New ADODB.Recordset
conn.Open "Dsn=HERIpub"
rec.Open ("Insert into tbl_Invoice (invoiceNumber,invoiceDate,invoiceAmount,invoiceDescription,invoiceFAU,invoiceCostCenter,invoiceProject,itemcode,invoicecFName,invoicecLName, invoicecAddr1, invoicecAddr2, invoicecCity, invoicecState, invoicecZIP, invoicecEmail, invoicecPhone) Values ('" & InstData(2) & "','" & invoiceDate & "','" & InstData(11) & "','Data Services','T6','T6','DATASL','40070DATASL','" & fname & "'" & ",'" & lname & "','" & InstData(4) & "', '" & InstData(5) & "', '" & InstData(6) & "', '" & InstData(7) & "', '" & InstData(8) & "', '" & InstData(10) & "', '" & InstData(9) & "')"), conn
macro error
Look at the variable fname , there you have redundant " & " . I think it should be:
rec.Open ("Insert into tbl_Invoice (invoiceNumber,invoiceDate,invoiceAmount,invoiceDescription,invoiceFAU,invoiceCostCenter,invoiceProject,itemcode,invoicecFName,invoicecLName, invoicecAddr1, invoicecAddr2, invoicecCity, invoicecState, invoicecZIP, invoicecEmail, invoicecPhone) Values ('" & InstData(2) & "','" & invoiceDate & "','" & InstData(11) & "','Data Services','T6','T6','DATASL','40070DATASL','" & fname & "','" & lname & "','" & InstData(4) & "', '" & InstData(5) & "', '" & InstData(6) & "', '" & InstData(7) & "', '" & InstData(8) & "', '" & InstData(10) & "', '" & InstData(9) & "')"), conn
Tell me if I'm right, or mark a vote up!
I have created a table where I'm saving attachments(in external folder) and file paths in the table. When I'm trying to update existing attachment with another, it does not work. Please see below "Add file" code and "Update button" code.
Private Sub cmAdd_Click()
On Error Resume Next
Dim strLokacioni As String
Dim strSQL As String
strLokacioni = "C:\Users\HSE\Desktop\datas\" & getFileName(Me.path.Value)
strSQL = "INSERT INTO tbl_tracker(path, filename, IncNo, PATS, SAP, First, Last, IncDate, Description, Location, OshaType, IncType, RootCause,Inspector, Surfaces, WeatherCon, WorkRelated, IncTime)" & _
"VALUES ( '" & strLokacioni & "', '" & Me.path.Value & "', '" & Me.txtInc & "', '" & Me.txtPATS & "', '" & Me.txtSAP & "', '" & Me.txtFirst & "', '" & Me.txtLast & "', '" & Me.txtDate & "', '" & Me.txtDesc & "', '" & Me.cmbLoc & "', '" & Me.cmbOsha & "', '" & Me.cmbType & "', '" & Me.txtCause & "', '" & Me.cmbInsp & "', '" & Me.cmbSur & "', '" & Me.cmbWcon & "', '" & Me.cmbRelated & "', '" & Me.txtTime & "')"
CurrentDb.Execute (strSQL)
MsgBox "Record Added", vbInformation, "Information"
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile Me.path.Value, strLokacioni
Set fso = Nothing
Me.tbl_tracker_subform.Form.Requery
End Sub
' Below is update button code
Private Sub Command88_Click()
'On Error Resume Next
Dim strLokacioni As String: strLokacioni = "C:\Users\HSE\Desktop\datas\" & getFileName(Me.path.Value)
Me.path = strLokacioni
CurrentDb.Execute "UPDATE tbl_tracker " & _
" SET IncNo = " & Me.txtInc & _
", path = '" & strLokacioni & "'" & _
", filename = '" & Me.filename & "'" & _
", PATS = '" & Me.txtPATS & "'" & _
", SAP = '" & Me.txtSAP & "'" & _
", First = '" & Me.txtFirst & "'" & _
", Last = '" & Me.txtLast & "'" & _
", IncDate = '" & Me.txtDate & "'" & _
", Location = '" & Me.cmbLoc & "'" & _
", Description = '" & Me.txtDesc & "'" & _
", OshaType = '" & Me.cmbOsha & "'" & _
", Inctype = '" & Me.cmbType & "'" & _
", RootCause = '" & Me.txtCause & "'" & _
", Inspector = '" & Me.cmbInsp & "'" & _
", Surfaces = '" & Me.cmbSur & "'" & _
", WeatherCon = '" & Me.cmbWcon & "'" & _
", WorkRelated = '" & Me.cmbRelated & "'" & _
", IncTime = '" & Me.txtTime & "'" & _
" WHERE IncNo = " & Me.txtInc.Tag
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile Me.path.Value, strLokacioni
Set fso = Nothing
MsgBox "Record Updated", vbInformation, "Information"
Me.tbl_tracker_subform.Form.Requery
End sub
And the the value Me.path.Value at the start of Command88_click is coming from :
Public Function getFileName(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
getFileName = getFileName(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Private Sub cbdBrowse_Click()
On Error Resume Next
Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
f.AllowMultiSelect = False
f.Show
Me.path.Value = f.SelectedItems(1)
End Sub
When I use update queries like you have here, I would always use the following syntax.
dim db as database
set db = currentDb
db.execute "UPDATE...."
would you require the same? Or have I been going about this a long way.
Also, I would have left a comment as this may not be the answer. Unfortunately, I cant due to rep<50
How I can prevent duplicate values to not insert into the table. I have created a code to INSERT, UPDATE and DELETE and I want to display a MsgBox that there is a duplicate value and to cancel it. Thanks. Below you have the code:
Private Sub Command12_Click()
If Me.emID.Tag & "" = "" Then
If (IsNull(Me.emID) Or (Me.emID = "") Or IsNull(Me.emFirst) Or (Me.emFirst = "") Or IsNull(Me.emLast) Or (Me.emLast = "")) Then
Me.emID.BorderColor = vbRed
Me.emFirst.BorderColor = vbRed
Me.emLast.BorderColor = vbRed
MsgBox "Please fill required fields", vbInformation, "Information"
Exit Sub
End If
CurrentDb.Execute "INSERT INTO tblEmployees(emID, first, last, gender, phone, mobphone, city, state, zip, adress, email, comment)" & _
"VALUES ('" & Me.emID & "', '" & Me.emFirst & "', '" & Me.emLast & "', '" & Me.emGender & "', '" & Me.emPhone & "', '" & Me.emMob & "', '" & Me.emCity & "', '" & Me.emState & "', '" & Me.emZip & "', '" & Me.emAdress & "', '" & Me.emEmail & "', '" & Me.emComment & "')"
MsgBox "Record Added", vbInformation, "information"
Else
CurrentDb.Execute "UPDATE tblEmployees " & _
"SET emiD =" & Me.emID & _
", first ='" & Me.emFirst & "'" & _
", last = '" & Me.emLast & "'" & _
", gender ='" & Me.emGender & "'" & _
", phone = '" & Me.emPhone & "'" & _
", mobphone ='" & Me.emMob & "'" & _
", city ='" & Me.emCity & "'" & _
", state ='" & Me.emState & "'" & _
", zip ='" & Me.emZip & "'" & _
", adress ='" & Me.emAdress & "'" & _
", email ='" & Me.emEmail & "'" & _
", comment ='" & Me.emComment & "'" & _
"WHERE emID =" & Me.emID.Tag
MsgBox "Updated!", vbInformation, "Information"
End If
Me.tblEmployees_subform.Form.Requery
End Sub
It sounds like you'd like to update an employee if one exists for the given ID otherwise you'd like to add a new employee. You can prevent adding duplicate employees by first trying to update an employee record with the given ID and if no records were updated only then do you add a new employee record.
Private Sub Command12_Click()
If (IsNull(Me.emID) Or (Me.emID = "") Or IsNull(Me.emFirst) Or (Me.emFirst = "") Or IsNull(Me.emLast) Or (Me.emLast = "")) Then
Me.emID.BorderColor = vbRed
Me.emFirst.BorderColor = vbRed
Me.emLast.BorderColor = vbRed
MsgBox "Please fill required fields", vbInformation, "Information"
Exit Sub
End If
' You must set CurrentDb to a variable otherwise the RecordsAffected
' property used later will be incorrect.
Dim db As DAO.Database
Set db = CurrentDb
' First try to update an existing employee.
db.Execute _
"UPDATE tblEmployees " & _
"SET first ='" & Me.emFirst & "', " & _
"last = '" & Me.emLast & "', " & _
"gender ='" & Me.emGender & "', " & _
"phone = '" & Me.emPhone & "', " & _
"mobphone ='" & Me.emMob & "', " & _
"city ='" & Me.emCity & "', " & _
"state ='" & Me.emState & "', " & _
"zip ='" & Me.emZip & "', " & _
"adress ='" & Me.emAdress & "', " & _
"email ='" & Me.emEmail & "', " & _
"comment ='" & Me.emComment & "'" & _
"WHERE emID =" & Me.emID.Tag & ";"
' If no records were affected by update then add a new employee.
If db.RecordsAffected = 0 Then
db.Execute _
"INSERT INTO tblEmployees(emID, first, last, gender, phone, mobphone, city, state, zip, adress, email, comment) " & _
"VALUES ('" & Me.emID & "', '" & Me.emFirst & "', '" & Me.emLast & "', '" & Me.emGender & "', '" & Me.emPhone & "', '" & Me.emMob & "', '" & Me.emCity & "', '" & Me.emState & "', '" & Me.emZip & "', '" & Me.emAdress & "', '" & Me.emEmail & "', '" & Me.emComment & "');"
MsgBox "Record Added", vbInformation, "Information"
Else
MsgBox "Updated!", vbInformation, "Information"
End If
Me.tblEmployees_subform.Form.Requery
End Sub
Note: In the update query I removed the update to the emID field since that is what the query is based on (in the WHERE clause). If the emID field is changing you won't be able to use the new emID value to find an employee record with the old emID value.
If you never want any duplicates I would also suggest that you add constraints to your database table to prevent duplicates, as suggested by Daniel Cook. I would also suggest looking into using parameterized queries instead of building SQL strings in VBA.
You can change your SQL to use IF EXISTS condition and insert only if the records does not already exists.
Your SQL may look like:
IF NOT EXISTS
(
SELECT ......
)
BEGIN
INSERT INTO tblEmployees ......<insert since employee does not exists>
END