I'm getting an error saying that Access cannot find the referenced form CFRRR but there is definitely a form there. Not sure if I'm just not writing the code correctly.
Public Function AssignNullProjects() As Long
Dim db As dao.Database
Dim rs As dao.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT CFRRRID, [program], [language] FROM CFRRR WHERE assignedto Is Null"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.BOF And Not rs.EOF Then
While Not rs.EOF
strSQL = "UPDATE CFRRR SET assignedto = " & GetNextAssignee & ", assignedby = " & [Forms]![CFRRR]![assignedby] & ", Dateassigned = #" & Now & "#, actiondate = #" & Now & "#, Workername = " & _ [Forms]![CFRRR]![assignedto] & ", WorkerID = " & [Forms]![CFRRR]![assignedto] & " WHERE CFRRRID = " & rs!CFRRRID
db.Execute strSQL, dbFailOnError
rs.MoveNext
Wend
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Public Function GetNextAssignee(program As String, Language As String) As Long
' Returns UserID as a Long Integer with the lowest [TS] value,
' and updates same [TS] by incremented with 1.
Dim db As dao.Database
Dim rs As dao.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT TOP 1 WorkerID FROM attendance WHERE [Programs] LIKE '*" & program & "*' AND [Language] = '" & Language & "' AND [Status] = '" & Available & "' ORDER BY TS ASC"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.BOF And Not rs.EOF Then
'Found next assignee, update date/time stamp
'strSQL = "UPDATE tblUser SET TS = " & DMax("[TS]", tblUser) + 1 & " WHERE [WorkerID]= " & rs!workerid
strSQL = "UPDATE attendance SET TS = " & DMax("[TS]", "attendance") + 1 & " WHERE [WorkerID]= " & rs!workerid
db.Execute strSQL, dbFailOnError
GetNextAssignee = rs!workerid
Else
'Field TS has NO VALUE FOR ALL RECORDS!
'Code calling this function should check for a return of 0 indicating an error.
GetNextAssignee = 0
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Related
I am using SQL update query in VBA and I am getting the datatype mismatch error. I know that error is basically because of the column spare part. The spare part column contains numeric and alphanumeric values.
Public Function UpdateDistinctColumnFRNumberBasis()
StrInvoiceNumber = "109839-01"
FRSparepartNumber = "FT7119907459"
MergedInvoiceFile = "/test.xlsx"
Dim objConn As Object
Dim objRecordSet As Object
Set objConn = CreateObject("ADODB.Connection")
Set objRecCmd = CreateObject("ADODB.Command")
Set objRecCmd_Update = CreateObject("ADODB.Command")
objConn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
MergedInvoiceFile & ";Extended Properties=""Excel 8.0;""")
strSQL = " Update [Tabelle1$] SET [Status] = 'Include' Where " & _
"([RECHNR] ='" & StrInvoiceNumber & "' AND [Sparepart] = " & FRSparepartNumber & ")"
objConn.Execute strSQL
objConn.Close
End Function
As commented, the partnumber is text, thus it must be quoted in the SQL:
FRSparepartNumber = "FT7119907459"
' snip
strSQL = "Update [Tabelle1$] SET [Status] = 'Include' Where " & _
"([RECHNR] = '" & StrInvoiceNumber & "' AND " & _
"[Sparepart] = '" & FRSparepartNumber & "')"
I am using MS Access 2010. I am trying to search a table and determine if the record exists based on First and Last name, If the record exists then update the record, and if it does not exist, then insert the new record. I am not getting any errors but I always get a recordcount of 1 even if I enter a name that I know does not exist in the table.
Private Sub txtSearchFirstName_Exit(Cancel As Integer)
Dim strSQL As String
Dim db As Database
Dim rs As DAO.Recordset
Dim recordCount As Long
Set db = CurrentDb
Set rs = Nothing
Stop
''Check if a keyword entered or not
If IsNull(Me.txtSearchlastName) = "" Then
MsgBox "Please type in your search keyword.", vbOKOnly, "Keyword Needed"
Else
strSQL = "SELECT COUNT(*) " & _
"FROM tblBobbettesMarketBulletin_CustNum " & _
"WHERE tblBobbettesMarketBulletin_CustNum.Last = " & Chr(34) & txtSearchlastName & Chr(34) & _
" AND tblBobbettesMarketBulletin_CustNum.First = " & Chr(34) & txtSearchFirstName & Chr(34)
Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If (rs.BOF And rs.EOF) Then
recordCount = 0
Else
rs.MoveLast
recordCount = rs.recordCount
End If
If recordCount > 0 Then MsgBox ("Record exists")
If recordCount = 0 Then MsgBox ("Record does not exist")
rs.Close
Set rs = Nothing
End If
End Sub
#HansUp describes your problem perfectly.
If you want to simplify the code and use this feature, assign a field name to your Count(*) and then query and use its value in one step
strSQL = "SELECT COUNT(*) AS NumFound " & _
"FROM tblBobbettesMarketBulletin_CustNum " & _
"WHERE tblBobbettesMarketBulletin_CustNum.Last = " & Chr(34) & txtSearchlastName & Chr(34) & _
" AND tblBobbettesMarketBulletin_CustNum.First = " & Chr(34) & txtSearchFirstName & Chr(34)
Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
MsgBox ("Found " & rs!NumFound & " Record(s)")
I currently open and fill a global table with the name ##GlobalTableMain via a macro at the moment. The table gets created the following way:
Public Sub ExecuteSQLQuery(sQuery As String)
Dim cn As New ADODB.Connection
cn.Open strConnection
cn.Execute "SET NOCOUNT ON;" & sQuery
cn.Close
End Sub
The Query roughly looks like this:
CREATE TABLE ##GlobalTableMain (Columns here);
INSERT INTO ##GlobalTableMain (Columns) VALUES
BUNCH OF ROWS
All of this worked just fine until I tried to add another macro that became necessary due to another factor.
The query in question:
Sub AggregateSQLTempTable(sTempTable As String, sAggClm As String)
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, sQuery As String
Dim selectClms As String, groupClms As String
cn.Open strConnection
sQuery = "SET NOCOUNT ON; SELECT tempdb.sys.columns.name FROM tempdb.sys.columns WHERE tempdb.sys.columns.object_id = Object_Id('tempdb.." & sTempTable & "')"
rs.Open sQuery, cn
sQuery = vbNullString
selectClms = vbNullString
groupClms = vbNullString
If Not (rs.EOF Or rs.BOF) Then
rs.MoveFirst
Do While Not (rs.EOF Or rs.BOF)
selectClms = selectClms & IIf(Len(selectClms) > 0, ", ", "") & IIf(rs!Name = sAggClm, "SUM(" & rs!Name & ") " & rs!Name, rs!Name)
groupClms = groupClms & IIf(rs!Name = sAggClm, "", IIf(Len(groupClms) > 0, ", ", "") & rs!Name)
rs.MoveNext
Loop
sQuery = vbNullString
sQuery = "SELECT * INTO #aggTempTable FROM (SELECT " & selectClms & " FROM " & sTempTable & " GROUP BY " & groupClms & ") a;"
sQuery = sQuery & Chr(10) & "TRUNCATE TABLE " & sTempTable & ";"
sQuery = sQuery & Chr(10) & "INSERT INTO " & sTempTable & " SELECT * FROM #aggTempTable;"
sQuery = sQuery & Chr(10) & "DROP TABLE #aggTempTable;"
cn.Execute sQuery
End If
rs.Close
cn.Close
End Sub
Supposedly SET NOCOUNT ON should prevent this but it doesn't work for me unfortunately.
I've found a solution that helps me do this.
I went ahead and made the Connection a public variable and added the following two macros. Here are all the new macros:
Public cn As New ADODB.Connection
Public Sub OpenSQLConnection()
If Not cn.State = adStateOpen Then cn.Open strConnection
End Sub
Public Sub CloseSQLConnection()
If Not cn.State = adStateClosed Then cn.Close
End Sub
Public Sub ExecuteSQLQuery(sQuery As String)
OpenSQLConnection
cn.Execute "SET NOCOUNT ON;" & sQuery
End Sub
Sub AggregateSQLTempTable(sTempTable As String, sAggClm As String)
Dim rs As New ADODB.Recordset, sQuery As String
Dim selectClms As String, groupClms As String
OpenSQLConnection
sQuery = "SET NOCOUNT ON; SELECT tempdb.sys.columns.name FROM tempdb.sys.columns WHERE tempdb.sys.columns.object_id = Object_Id('tempdb.." & sTempTable & "')"
rs.Open sQuery, cn
sQuery = vbNullString
selectClms = vbNullString
groupClms = vbNullString
If Not (rs.EOF Or rs.BOF) Then
rs.MoveFirst
Do While Not (rs.EOF Or rs.BOF)
selectClms = selectClms & IIf(Len(selectClms) > 0, ", ", "") & IIf(rs!Name = sAggClm, "SUM(" & rs!Name & ") " & rs!Name, rs!Name)
groupClms = groupClms & IIf(rs!Name = sAggClm, "", IIf(Len(groupClms) > 0, ", ", "") & rs!Name)
rs.MoveNext
Loop
sQuery = vbNullString
sQuery = "SELECT * INTO #aggTempTable FROM (SELECT " & selectClms & " FROM " & sTempTable & " GROUP BY " & groupClms & ") a;"
sQuery = sQuery & Chr(10) & "TRUNCATE TABLE " & sTempTable & ";"
sQuery = sQuery & Chr(10) & "INSERT INTO " & sTempTable & " SELECT * FROM #aggTempTable;"
sQuery = sQuery & Chr(10) & "DROP TABLE #aggTempTable;"
cn.Execute sQuery
End If
rs.Close
End Sub
I can't get this code to work. The first time I ran it, it prompted me for my password and the macro completes each time, but it is not pulling the result into sheet1. What can I do here?
Sub Update()
ThisWorkbook.Sheets("sheet1").Activate
ThisWorkbook.Sheets("sheet1").Range("A1").Select
Dim strStDt As String
Dim strEnDt As String
Dim strSQL As String
strStDt = ThisWorkbook.Worksheets("lookup").Range("B6").Value
strEnDt = ThisWorkbook.Worksheets("lookup").Range("B5").Value
strSQL = ""
strSQL = strSQL & "SELECT tkt.cntry_istto"
strSQL = strSQL & ",tkt.pod"
strSQL = strSQL & " FROM INTGY.GRUIP tkt"
strSQL = strSQL & " Where tky.year_month_nbr between " & strStDt & " and " & strEnDt
ThisWorkbook.Sheets("sheet1").Activate
ThisWorkbook.Sheets("sheet1").Range("A1").Select
With ActiveWorkbook.Connections(1).ODBCConnection
.BackgroundQuery = True
.Connection = "ODBC;DSN=#EDXX;UID=;;DATABASE=INTGY; AUTHENTICATION=;"
.CommandText = strSQL
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
.Refresh
End With
End Sub
Did you verify that strSQL is being entered correctly into your query? Put Msgbox strSQL before With ActiveWorkbook.Connections(1).ODBCConnection and make sure it appears as expected.
Also, all of this:
strSQL = ""
strSQL = strSQL & "SELECT tkt.cntry_istto"
strSQL = strSQL & ",tkt.pod"
strSQL = strSQL & " FROM INTGY.GRUIP tkt"
strSQL = strSQL & " Where tky.year_month_nbr between " & strStDt & " and " & strEnDt
Can be rewritten as:
strSQL = "SELECT tkt.cntry_istto,tkt.pod FROM INTGY.GRUIP tkt Where tky.year_month_nbr between " & strStDt & " and " & strEnDt
Use an ADO connection to retrieve a recordset and then use CopyFromRecordset to copy to worksheet range (specifying only the upper left cell).
Also, I am unaware of the database but pay attention to your dates which must be enclosed with either single quotes (for most databases) or if using MS Access enclose with # instead of quotes.
Dim conn As Object
Dim rst As Object
Dim strSQL As String, strStDt As String, strEnDt As String
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
strStDt = ThisWorkbook.Worksheets("lookup").Range("B6")
strEnDt = ThisWorkbook.Worksheets("lookup").Range("B5")
strSQL = "SELECT tkt.cntry_istto, tkt.pod"
strSQL = strSQL & " FROM INTGY.GRUIP tkt"
strSQL = strSQL & " WHERE tkt.year_month_nbr"
strSQL = strSQL & " BETWEEN '" & strStDt & "' and '" & strEnDt & "'
conn.Open "DSN=#EDXX"
rst.Open strSQL, conn
ThisWorkbook.Sheets(1).Range("A1").CopyFromRecordest rst
rst.Close
Set rst = Nothing
Set conn = Nothing
I'm getting a Parameters error here: db.Execute strSQL, dbFailOnError saying "too few parameters, expected 1". I'm not sure exactly why. I'm referencing both tables. I'm also not 100% this is written correctly Workername = " & DLookup("username", "attendance", GetNextAssignee("program", "Language", "username")) I want [Workername] field to update to the workername that is linked to the GetNextAssignee("program", "Language", "username") which I'm not getting and it could be connected to the this error.
Public Function AssignNullProjects() As Long
Dim db As dao.Database
Dim rs As dao.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT CFRRRID, [program], [language] FROM CFRRR WHERE assignedto Is Null"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.BOF And Not rs.EOF Then
While Not rs.EOF
strSQL = "UPDATE CFRRR,attendance SET assignedto = " & GetNextAssignee("program", "Language", "username") & ", assignedby = " & Forms!Supervisor!NavigationSubform!assignedby.Value & ", Dateassigned = #" & Now & "#, actiondate = #" & Now & "#, Workername = " & _
DLookup("username", "attendance", GetNextAssignee("program", "Language", "username")) & ", WorkerID = " & DLookup("UserID", "attendance", GetNextAssignee("program", "Language", "username")) & " WHERE CFRRRID = " & rs!CFRRRID
Debug.Print strSQL
db.Execute strSQL, dbFailOnError
rs.MoveNext
Wend
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Here is what the Debug.Print strSQL shows:
UPDATE CFRRR,attendance
SET
assignedto = 7,
assignedby = 33,
Dateassigned = #5/16/2015 11:16:31 AM#,
actiondate = #5/16/2015 11:16:31 AM#,
Workername = Lillian,
WorkerID = 6
WHERE CFRRRID = 6
It seems Workername is a text field and you want to store the string Lillian there. Add quotes so the db engine will understand Lillian is literal text instead of the name of a parameter.
UPDATE CFRRR
SET
assignedto = 7,
assignedby = 33,
Dateassigned = Now(),
actiondate = Now(),
Workername = 'Lillian',
WorkerID = 6
WHERE CFRRRID = 6
Since the db engine supports the Now() function, you can ask it to store the value of Now() in your Dateassigned and actiondate fields. That is simpler than taking the value of Now() in VBA and then adding # characters around that value to concatenate into the statement text.
I'm skeptical that UPDATE CFRRR,attendance was the right choice. That would be a CROSS JOIN between the two tables and Access may therefore decide the query is not updateable. I suggest you UPDATE just the CFRRR table.