I have this code:
If Len(Me.Text9.Value & vbNullString) = 0 Then
sSQL = "SELECT [Ra 1080] as [civil] FROM civil where main=" & Forms![PDS Main Form]![Main Table ID] & " ORDER BY ID"
Set rs = db.OpenRecordset(sSQL)
rs.MoveFirst
Do Until rs.EOF
Text9.Value = Text9.Value + rs!civil + ", "
rs.MoveNext
Loop
Set rs = Nothing
End If
If you run the query it would return 3 records cs1.5,cs1.3,cs1.9
running the code the textbox would only return cs 1.3, cs 1.9,
Not sure using MoveFirst would have caused the trouble, try this code. See if it works.
If Len(Me.Text9.Value & vbNullString) = 0 Then
sSQL = "SELECT [Ra 1080] As [civil] FROM civil WHERE main = " & _
Forms![PDS Main Form]![Main Table ID] & " ORDER BY ID"
Set rs = db.OpenRecordset(sSQL)
Do While Not rs.EOF
Text9.Value = Text9.Value & rs!civil & ", "
rs.MoveNext
Loop
Set rs = Nothing
End If
Just taken away the .MoveFirst and few other simple modifications.
Related
I tested my code with static value
Set rs = CurrentDb.OpenRecordset("SELECT mail FROM UsersData WHERE depid = 2")
and it worked, but when I use the full statement
Set rs = CurrentDb.OpenRecordset( _
"SELECT mail FROM UsersData WHERE depid IN (SELECT depid FROM CyclesDefinitions WHERE cycledefid = " _
& Me.Combo135.Value & " AND rank = " & Me.Combo202.Value) & ")"
it generates an error i don't know what it means
(Compile Error: Type mismatch) and then nothing happens.
full code below: (everything works as intended and tested, but this line)
Private Sub Command15_Click()
Dim dbs As Database
Dim qdf As QueryDef
Set dbs = CurrentDb
Dim StrSqls As String
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT mail FROM UsersData WHERE depid IN (SELECT depid FROM CyclesDefinitions WHERE cycledefid = " & Me.Combo135.Value & " AND rank = " & Me.Combo202.Value) & ")"
'Set rs = CurrentDb.OpenRecordset("SELECT mail FROM UsersData WHERE depid = 2")
Dim ToMails As String
'Check is a flag on form to make sure record is not inserted more than once in Cycles Table
If Me.Check137.Value = False Then
DoCmd.RunCommand acCmdSaveRecord
dbs.Execute "INSERT INTO Cycles (scinvid, cycledefid) VALUES (" & Me.Combo200.Value & ", " & Me.Combo135.Value & ");"
dbs.Close
Me.Check137.Value = True
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
ToMails = rs(0) & ";" & ToMails
rs.MoveNext
Loop
Else
MsgBox "There are no Emails recorded for such department"
End If
rs.Close 'Close the recordset
Debug.Print ToMails
Set rs = Nothing 'Clean up
DoCmd.SendObject acSendNoObject, , , ToMails, , , "Test Subject", "Test Message", True
'objRecordset.Open ("SELECT depid FROM CyclesDefinitions WHERE cycledefid =" & Me.Combo135.Value & " AND cycleranktracking =" & Me.Combo202.Value)
'UserDepartmentID = DLookup("depid", "UsersData", "[username]= '" & fOSUserName & "'")
DoCmd.GoToRecord , , acNewRec
Me.Combo83.Requery
Combo83.RowSource = "SCINVSearch"
ElseIf Me.Check137.Value = True Then
DoCmd.GoToRecord , , acNewRec
Me.Combo83.Requery
Combo83.RowSource = "SCINVSearch"
End If
End Sub
In
Set rs = CurrentDb.OpenRecordset( _
"SELECT mail FROM UsersData WHERE depid IN (SELECT depid FROM CyclesDefinitions WHERE cycledefid = " _
& Me.Combo135.Value & " AND rank = " & Me.Combo202.Value) & ")"
You have placed the closing brace at the wrong place. It should be
Set rs = CurrentDb.OpenRecordset( _
"SELECT mail FROM UsersData WHERE depid IN (SELECT depid FROM CyclesDefinitions WHERE cycledefid = " _
& Me.Combo135.Value & " AND rank = " & Me.Combo202.Value & ")")
Your version tries to append a ")" to the Recordset instead of the SQL string. This generates the Type mismatch error.
I'm passing record set from one function (i.e.chkMismatchData) to another (CheckMismatches) and if the record is not found I update some values of passed recordset.
Even I declare variable of recordset in module level still finding the error.
My code is :
Set rec1 = CurrentDb.OpenRecordset("select * from CBWCFAVENDORMATCHOFFMASTER where [vendor]='" & rec![Vendor] & "'")
While Not rec.EOF
Set rec3 = CurrentDb.OpenRecordset("select ID,[HCI_NO],CLEARLOC,SUM([AMOUNT])AS AMOUNT1 from CBWCFAMISUPLOAD WHERE [vendor]='" & rec![Vendor] & "' and nz([match],'')='' and nz([HCI_NO],'')<>'' GROUP BY HCI_NO,CLEARLOC,ID ")
While Not rec3.EOF
Set rec2 = CurrentDb.OpenRecordset("select ID,DEPSLIPNO,CLEARLOC from CBWCFAPENDINGPAYMENTDATA WHERE [DEPSLIPNO]='" & rec3![HCI_NO] & "' GROUP BY DEPSLIPNO,CLEARLOC,ID HAVING CLEARLOC='" & rec3![CLEARLOC] & "' AND SUM([amt])=" & rec3![AMOUNT1])
If rec2.EOF = False Then
If rec2.RecordCount = 1 Then
CurrentDb.Execute ("UPDATE CBWCFAMISUPLOAD SET [MATCH]='Y' ,[CASHIN_ID]='" & rec2![ID] & "' WHERE [HCI_NO]='" & rec3![HCI_NO] & "' ")
CurrentDb.Execute ("UPDATE CBWCFAPENDINGPAYMENTDATA SET [MATCH]='Y' ,[MIS_ID]='" & rec3![ID] & "' WHERE [DEPSLIPNO]='" & rec3![HCI_NO] & "'")
ElseIf rec1.RecordCount > 1 Then
Call UpdateRec(rec3, 0, "Duplicate Match", 0)
End If
Else
strSlipType = "HCI_NO"
Call UpdateRec(rec3, 0, CheckMismatches(rec3), 0) 'here im passing
End If
rec3.MoveNext
Wend
Wend
Private Function CheckMismatches(rec As DAO.Recordset) As String
Dim RecCheck As DAO.Recordset
Dim strDepSlipNo As String, strID As String
If strSlipType = "HCI_NO" Then
'--Clearing Loc Not Matching
Set RecCheck = CurrentDb.OpenRecordset("select ID,DEPSLIPNO,CLEARLOC from CBWCFAPENDINGPAYMENTDATA WHERE [DEPSLIPNO]='" & rec![HCI_NO] & "' GROUP BY DEPSLIPNO,CLEARLOC,ID HAVING CLEARLOC<>'" & rec![CLEARLOC] & "' AND SUM([amt])=" & rec![AMOUNT1])
If RecCheck.EOF = True Then
rec.Edit 'here i'm geting error
rec![match]="Y" 'added line
rec!.update 'added line
CheckMismatches = "Clearing Loc Not Matching"
RecCheck.Close
Exit Function
End If
RecCheck.Close
end function
Your rec3 has a GROUP BY clause.
A recordset that is aggregated is by definition read-only. So you have to edit the table separately from this recordset.
Why do you have rec.Edit in the function when you don't edit any fields of it?
My form takes the data the user entered, constructs a SQL statement and returns the results. I would like to have a message box pop up when there are no matches found.
My current code/idea:
If qdf.sql = 0 Then
MsgBox "No clients matching your information." & _
vbCrLf & "have been found. Please try again." & _
, vbCritical, "No Matches"
Else
DoCmd.OpenForm "frmSearchResults"
Me.Visible = False
End If
I'm having trouble figuring out the correct syntax for if qdf.sql = 0 .
UPDATE: Full query
Private Sub cmdSearch_Click()
'On Error GoTo cmdSearch_Click_err
Dim db As Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim qdf As QueryDef
Dim strClientID As String
Dim strLastName As String
Dim strFirstName As String
Dim strDOB As String
Set db = CurrentDb
Set rs = db.OpenRecordset(qdf.sql)
' call QueryCheck module to determine if query exists
If Not QueryExists("qrySearch") Then
Set qdf = db.CreateQueryDef("qrySearch")
Else
Set qdf = db.QueryDefs("qrySearch")
End If
' handle nulls in the user's entries
If IsNull(Me.txtClientID.Value) Then
strClientID = " Like '*' "
Else
strClientID = "='" & Me.txtClientID.Value & "' "
End If
If IsNull(Me.txtLastName.Value) Then
strLastName = " Like '*' "
Else
strLastName = " Like '" & Me.txtLastName.Value & "*' "
End If
If IsNull(Me.txtFirstName.Value) Then
strFirstName = " Like '*' "
Else
strFirstName = " Like '*" & Me.txtFirstName.Value & "*' "
End If
If IsNull(Me.txtDOB.Value) Then
strDOB = " Like '*' "
Else
strDOB = "='" & Me.txtDOB.Value & "' "
End If
strSQL = "SELECT Clients.* " & _
"FROM Clients " & _
"WHERE Clients.clientid" & strClientID & _
"AND Clients.namelast" & strLastName & _
"AND Clients.namefirst" & strFirstName & _
"AND Clients.birthdate" & strDOB & _
"ORDER BY Clients.namelast,Clients.namefirst;"
Debug.Print strSQL
' check to see if the results form is open and close if it is
DoCmd.Echo False
If Application.SysCmd(acSysCmdGetObjectState, acForm, "frmSearchResults") = acObjStateOpen Then
DoCmd.Close acForm, "frmSearchResults"
End If
' run SQL statment
qdf.sql = strSQL
' check for no matches found
If rs.RecordCount = 0 Then
MsgBox "No clients matching your information were found." & _
vbCrLf & "Please search again.", vbInformation, "No Matches"
Else
DoCmd.OpenForm "frmSearchResults"
Me.Visible = False
End If
'cmdSearch_Click_exit:
' DoCmd.Echo True
' Set qdf = Nothing
' Set db = Nothing
'Exit Sub
'cmdSearch_Click_err:
' MsgBox "An unexpected error has occurred." & _
' vbCrLf & "Please note of the following details and contact the EIIS support desk:" & _
' vbCrLf & "Error Number: " & Err.Number & _
' vbCrLf & "Description: " & Err.Description _
' , vbCritical, "Error"
' Resume cmdSearch_Click_exit
End Sub
The reason that If qdf.sql = 0 then won't perform a proper check is that qdf contains the information about your query such as the SQL text that you are checking in that statement but not the results.
To get the results of the query you need to assign it to a Recordset after you have build your query. So first build your query and then assign it to the record set.
Dim db as DAO.Database
Set db = CurrentDb
Dim qdf as DAO.Querydef
Set qdf = db.CreateQueryDef("qrySearch")
Dim rs as DAO.Recordset
Set rs = CurrentDb.OpenRecordset(qdf.sql)
You can then check what your record set has returned.
If rs.RecordCount = 0 then
So where you have your line ' run SQL statment you would want to place the Set rs line.
If you have any ADO experience you can use something like
dim strSQL as String
dim conn as Connection
dim cmd as Command
dim rs as Recordset
(set up connection/command here)
cmd.commandtext = (your select query)
set rs = Command.execute
if rs.eof then
(or if rs.recordcount = 0 however returning a recordcount requires the correct cursortype - usually adOpenStatic - to be used)
'msgbox no match
else
'do stuff
If any of this is alien, then post your actual query and I'll try and give you the code in full. Good luck!
How do I move past 'No Current Record' to next Record where 'Item' = 'Item'
Loop comes back around and finds a Sales Order record in rsSO but not in rsInv or the Inventory recordset, creating the "Record not found error." The reason is that once the Inventory is depleted by allocating it to open Sales Orders I then delete the Inventory record for that specific item but there still may me open sales order left for that item. How do I move to the next item in the Open Sales Order rsSO recordset once the Inventory is depleted in rsInv?
It is happening in the following section of code inside the first loop:
Do Until rsInv!Item = rsSO!Item
If rsInv!Item = rsSO!Item Then
Exit Do
Else
rsInv.MoveNext
End If
Loop
Entire code:
Public Function UpdateInventoryIntl()
Dim rsInv As DAO.Recordset, rsSO As DAO.Recordset, db As DAO.Database
Dim qdf As DAO.QueryDef
Dim AllocationQty As Long, SaleOrderRemainder As Long
Set db = CurrentDb
Set rsInv = CurrentDb.OpenRecordset( _
"SELECT * FROM [tbl_InventoryAvailForIntl] ORDER BY [Item] DESC,[QOH_IntlAllocation] DESC", _
dbOpenDynaset)
Set rsSO = CurrentDb.OpenRecordset("SELECT * FROM [tbl_IntlAllocated] ORDER BY [Item] DESC,[Qty_Open] DESC", _
dbOpenDynaset)
Do Until rsSO.RecordCount = 0
Do Until rsInv!Item = rsSO!Item
If rsInv!Item = rsSO!Item Then
Exit Do
Else
rsInv.MoveNext
End If
Loop
AllocationQty = IIf(rsSO!Qty_Open > rsInv!QOH_IntlAllocation, rsInv!QOH_IntlAllocation, rsSO!Qty_Open)
db.Execute ("INSERT INTO tbl_IntlAllocatedResults (Due_Date, Sale_Order_Num, SO_Line, Item, Qty_OpenStart, Location, Lot, QtyAllocated) " & _
"VALUES (#" & rsSO!Due_Date & "#,'" & rsSO!Sale_Order_Num & "'," & rsSO!SO_Line & ",'" & rsSO!Item & "'," & rsSO!Qty_OpenStart & ",'" & rsInv!Location & "','" & rsInv!Lot & "'," & AllocationQty & ");")
rsSO.Edit
rsSO!Qty_Open = rsSO!Qty_Open - AllocationQty
rsSO.Update
If rsSO!Qty_Open = 0 Then
rsSO.Delete
rsSO.MoveNext
End If
rsInv.Edit
rsInv!QOH_IntlAllocation = rsInv!QOH_IntlAllocation - AllocationQty
rsInv.Update
Debug.Print rsInv!QOH_IntlAllocation
If rsInv!QOH_IntlAllocation = 0 Then
rsInv.Delete
rsInv.MoveNext
End If
Loop
rsSO.Close
Set rsSO = Nothing
Set qdf = Nothing
rsInv.Close
Set rsInv = Nothing
End Function
Rather than cycling through the recordset use FindFirst:
Dim sCriteria as String
sCriteria = "Item = " & rsSO!Item
rsInv.FindFirst (sCriteria)
If rsInv.NoMatch Then
' Do whatever you need to if there is no inventory
Else
' Carry on with your code
End If
You may get better efficiency picking up the recordset as you need it, depending on the size of recordset.
Don't set your rsInv initially and then instead of your problematic loop use:
Set rsInv = Currentdb.OpenRecordset( _
"SELECT * FROM [tbl_InventoryAvailForIntl] _
WHERE [Item] = " & rsSO!Item & " ORDER BY [QOH_IntlAllocation] DESC", _
dbOpenDynaset)
You can then test if there are no records:
If rsInv.EOF and rsInv.BOF Then
' No records, do what is required when no inventory
End If
I have very little experience with Access Databases however I have wrote a similar VBA macro in excel. I am trying to copy rows from one .mdb file into the exact same table on a different .mdb file. However I would like it to only import it if it does not already exsist. Could someone please advise me the best way to go about this and maybe some code I can use and modify? I have already looked around stack overflow and can't seem to find any examples that work.
There are 8 different tables and inside these a few hundred rows. with maybe 5-20 columns.
If the script could be made inside VBS this would be ideal, as it would allow me to run the updates without loading into access.
Thanks for any help or advice,
Simon
EDIT -
Zev's answer seems to do the job however I am getting this error, also the MDB inside site2 is the one I am copying from and putting it into site1
Error: Expected end of statement
Code: 800A0401
Line: 17
Char: 13
Code (saved as "update.vbs"):
Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("C:\Users\simon\Documents\garden games redesign\import script\Site1\ActinicCatalog.mdb")
Sub CopyTable()
Dim rs
Set rs = dest.OpenRecordset("Person")
Dim sWhere
For Each fld In rs.Fields
sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
Next
sWhere = Mid(sWhere, 6)
Dim sql: sql= _
"INSERT INTO Person " & _
"SELECT * " & _
"FROM Person AS t1 IN ""C:\Users\simon\Documents\garden games redesign\import script\Site2\ActinicCatalog.mdb"" " & _
"WHERE " & sWhere
dest.Execute(sql)
End Sub
Edit for more info:
\Site1\ActinicCatalog.mdb - is destination database
\Site2\ActinicCatalog.mdb - is original database
These databases have about 20 columns
Here is an example to get you started. It copies the content of [Table1] of the current database to [Table1] of a second database.
Option Compare Database
Option Explicit
Sub copyTables()
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("C:\Users\Admin\Desktop\DBdest.accdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("Table1", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("Table1", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Look for record in dest recordset
rDest.FindFirst _
"Field1 = '" & rSource.Fields("Field1") & "' AND " & _
"Field2 = " & rSource.Fields("Field2")
'If not found, copy record - Field1 is text / Field2 is numeric
If rDest.NoMatch Then
rDest.AddNew
rDest.Fields("Field1") = rSource.Fields("Field1")
rDest.Fields("Field2") = rSource.Fields("Field2")
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Sub
I would suggest using an SQL statement if possible. From VBScript using DAO/ACE:
Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("path\to\destination\database.accdb")
Using ADO:
Dim conn
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""path\to\destination\database.accdb"";"
.Open
End With
The SQL statement would be something like this:
INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
WHERE Table1.Field1 <> t1.Field1
and executed like this:
Dim sql = _
"INSERT INTO Table1 " & _
"SELECT * " & _
"FROM Table1 AS t1 IN "path\to\source\database.accdb" " & _
"WHERE Table1.Field1 <> t1.Field1"
'Using DAO or ADO
dest.Execute sql
Considering that each table has a variable number of columns, you might have to generate the WHERE expression dynamically:
Sub CopyTable(tablename)
Dim rs
Set rs = dest.OpenRecordset(tablename)
'if using ADO:
'Set rs = conn.Execute(tablename)
Dim sWhere
For Each fld In rs.Fields
sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
Next
sWhere = Mid(sWhere, 6)
Dim sql
sql = _
"INSERT INTO " & tablename & " " & _
"SELECT * " & _
"FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
"WHERE " & sWhere
dest.Execute(sql)
End Sub
Update
If you are only using one column to determine whether the record exists, the SQL statement should look like this:
INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
LEFT JOIN Table1 ON t1.FirstField = Table1.FirstField
WHERE Table1.FirstField IS NULL
and CopyTable like this:
Sub CopyTable(tablename)
Dim rs
Set rs = dest.OpenRecordset(tablename)
'if using ADO:
'Set rs = conn.Execute(tablename)
Dim field0Name
field0Name=rs.Fields(0).Name
Dim sql
sql = _
"INSERT INTO " & tablename & " " & _
"SELECT * " & _
"FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
"LEFT JOIN " & tablename & " ON t1." & field0Name & "=" & tablename & "." & field0Name & " " & _
"WHERE " & tablename & "." & field0Name & " IS NULL"
dest.Execute(sql)
End Sub