IF 'x' matches 'y' then Merge With Existing Else Create New - vba

I need to import 'contacts' into my database from several external sources.
Some 'contacts' may already exist so I only need 'new' data.
I've written an update records code however it will overwrite all data therefore damaging the integrity of the table as the old data may contain some valid values.
I tried using an update/append query however this only OVERWROTE the values of the original field not UPDATED IF OLD VALUE WAS NULL/FALSE ONLY. The issue with this is it will apply/remove profile flags that result in correspondence and data usage (Incorrect update = potential breach of GDPR).
I can't program in SQL, I understand how the functions work and what they do but not how to compile/what order (yet) hence using VBA for now.
Dim myR As Recordset
Dim myR2 As Recordset
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
Else
myR2.Edit
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
End If
myR.MoveNext
Loop
Set myR = Nothing
End Sub
Is there a simpler way to write this or should I be utilising the code
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
For each value, creating effectively 15-20 subs and a macro to run all together?
I tried several code variations attempting to include elseIf, isNull() and isFalse() however they always failed to compile or no update was completed/records changed.
I need the code to do the following:
Check the contact exists in contacts table
If contact does not exist, add all data
If contact does exist, add new data or update yes/no fields from no to yes
NOTE: Currently 'contacts' table is empty as we need to create new/merge duplicates before the data is imported to the 'contacts' table.
So Contacts is currently:
Email Name Surname
- - -
- - -
- - -
- - -
Staging - Import is currently:
Email Name Surname
b#b.c Brad
t#b.c Tony Tiger
b#b.c B Pitt
r#b.c Ryan Reynolds
Contacts should look like this after completed:
Email Name Surname
t#b.c Tony Tiger
b#b.c Brad Pitt
r#b.c Ryan Reynolds


Determining what to update or add when comparing string data can be quite complicated and often involves case-by-case review. What rule should be applied to program decision to take "Brad" from one record and "Pitt" from other? What if data for the same email were: Brad Pitt and Bradley Pitt? Which is correct and should be saved? Probably have to do a query that finds duplicate emails in Staging and make case-by-case decision on what to fix/delete for these duplicates. Then insert to Contacts. Insert code can test content of each field for Null or False and determine whether to accept new value.
For non-yes/no field, use Nz() function (assumes text field will not have empty string)
myR2![First Name] = Nz(myR2![First Name], myR![First Name])
or (to deal with possible empty string)
If myR2![First Name] & "" = "" Then myR2![First Name] = myR![First Name]
(advise not to allow empty string in text field nor zero default value for number field in table design).
For yes/no field, test for False (do not set DefaultValue property in table design):
myR2![Supress] = IIf(myR2![Supress] = False, myR![Supress], True)
or
If myR2![Supress] = False Then myR2![Supress] = myR![Supress]
Shorter code for import procedure. Modify with the above.
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![WebSite] = myR![WebSite]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Supress]
myR2.Update
myR.MoveNext
Loop
Another, assuming recordsets have exactly same fields.
Dim myR As DAO.Recordset
Dim myR2 As DAO.Recordset
Dim fld As DAO.Field
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst "Email = '" & myR![Email] & "'"
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
For Each fld In myR.Fields
If fld.Name <> "Email" And _
(myR2.Fields(fld.Name) & "" = "" Or myR2.Fields(fld.Name) = False) Then
myR2.Fields(fld.Name) = fld
End If
Next
myR2.Update
myR.MoveNext
Loop

Related

I am trying to check if a value isl Resistant in a table from a Form using dlookup

I am trying to lookup a value in a table for a particular patient ID and see whether that patient has the value Resistant. If so then disable a particular button on the form. I tried the following dlookup but it's giving me compiler error:
If DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID) = Resistant Then
Me.btnDSTMatch.Enabled = True
Else
Me.btnDSTMatch.Enabled = False

Try with:
If DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & "") = "Resistant" Then
Me.btnDSTMatch.Enabled = True
Else
Me.btnDSTMatch.Enabled = False
End If
Or perhaps directly:
Me.btnDSTMatch.Enabled = IsNull(DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant'"))
To filter on the latest date you can include a DMax expression or (the little known option) an SQL filter:
Me.btnDSTMatch.Enabled = IsNull(DLookup("Rifampicin", "TableGeneXpert", "[PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant' And [JournalDate] = (Select Max([JournalDate]) From TableGeneXpert Where [PatientID] = " & Forms.FrmTreatment!PatientID & " And [Rifampicin] = 'Resistant')"))

Update previous row

I have an Excel file that contains some datas that I want to export into an Access db. In the C column I've got a field called 'Description'. Usually this field occupy just one cell, but it can happens that is more long.
In this case, for example, AP.01 has got 5 rows of description. How can update the first row with the next rows?
Public Sub updateDB(ByVal PathDB As String, str As String, id As Integer)
Dim db As New cDB
Dim v As New cVoce
Dim rs As ADODB.Recordset = db.RecordSet
v.Description = str
db.connetti_DB(PathDB)
db.get_rs("UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'")
End Sub
Public Function get_rs(ByVal query As String) As ADODB.Recordset
If db Is Nothing Then rs = Nothing : Return rs
rs = New ADODB.Recordset
rs.CursorType = ADODB.CursorTypeEnum.adOpenStatic
rs.LockType = ADODB.LockTypeEnum.adLockOptimistic
rs.Open(query, db)
Return rs
End Function
This code doesn't work because I update my current row, for this reason is useless the UPDATE instruction. How can I fix my code?
EDIT I post here the For loop
For r = 2 To grid.RowCount - 1
vett = Split(grid(r, 1).Text)
total = UBound(Split(grid(r, 1).Text, "."))
If grid(r, 1).Text <> "" Then
Select Case total
Case 0
Dim chapter As New cChapter
flag = 1
id = id + 1
chapter.Cod = grid(r, 1).Text.Substring(0, 1)
chapter.Description = grid(r, 3).Text
If Left(vett(0), 1) >= Chr(65) And Left(vett(0), 1) <= Chr(90) Then
chapter.Cod = Left(vett(0), 1)
oldChap = chap.Cod
If chapter.Cod <> oldCap Then
chapters.Add(chapter)
End If
End If
chapters.Add(chapter)
stringChap = chap.Description
Dim par As New cParagraph
If Left(vett(0), 2) >= Chr(65) And Left(vett(0), 2) <= Chr(90) Then
par.Cod = Left(vett(0), 2)
par.Cod_Chapter = Left(vett(0), 1)
oldPar = par.Cod
If par.Cod <> oldPar Then
paragraphs.Add(par)
End If
End If
If grid(r, 3).Text.Length > 255 Then
par.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
par.Description = grid(r, 3).Text.ToString
End If
paragraphs.Add(par)
stringPar = par.Description
Case 1
flag = 2
id = id + 1
c_Voc = voc.Cod_Chapter
p_Voc = voc.Cod_Paragraph
voc.Cod_Chapter = grid(r, 1).Text.Substring(0, 1)
voc.Cod_Paragraph = grid(r, 1).Text.Split(".")(0)
voc.Cod_Voice = Right(vett(0), 2)
If grid(r, 3).Text.Length > 255 Then
voc.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
voc.Description = grid(r, 3).Text.ToString
If voc.Description.EndsWith("-") Then
a = Replace(voc.Description, "-", "")
voc.Description = a
End If
End If
stringVoice = voc.Description
voices.Add(voc)
voices.Save_DB(dbDest)
Case 2
flag = 3
id = id + 1
sVoice = New cVoice
oldSvoice = voice.Cod_SVoice
sVoice.Cod_SVoice = Left(vett(0), 2)
If sVoice.Cod_SVoce <> oldSvoice Then
voices.Add(sVoice)
voices.Save_DB(dbDest)
End If
If grid(r, 3).Text.Length > 255 Then
sVoice.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
sVoice.Description = grid(r, 3).Text
End If
stringSvoice = sVoice.Description
sVoice.Cod_Voce = Left(vett(0), 5)
sVoice.Price1 = grid(r, 12).Text
sVoice.Price2 = sVoice.Price1
sVoice.UniMi = grid(r, 11).Text
sVoce.Sep = "."
voices.Add(sVoce)
voices.Save_DB(dbDest)
End Select
Else
If flag = 1 Then
stringChap = grid(r, 3).Text
chap.Description = stringChap & grid(r, 3).Text
stringPar = grid(r, 3).Text
paragraph.Description = stringPar & grid(r, 3).Text
End If
If flag = 2 Then
stringVoice = grid(r, 3).Text
voc.Description = voc.Description & stringVoice
voices.updateDB(dbDest, stringVoice, id)
voices.Add(voc)
End If
If flag = 3 Then
stringSvoice = grid(r, 3).Text
sVoice.Description = stringSvoice & grid(r, 3).Text
voices.Add(sVoice)
End If
chapter.Save_DB(dbDest)
paragraph.Save_DB(dbDest)
voice.Save_DB(dbDest)
End If
Next
EDIT2 I declared id As Integer and when Code column has a value then id=id+1. In this way I always know which row I have to modify. I modified also updateDB (now I'm using 3 parameters) and I added a WHERE condition into my query. Despite the update, nothing has changed

In database you cannot store records without PrimaryKey (actually you can, but it is bad idea). Since in your solution id is in fact Excel row number (sorry if I'm not correct but it looks like from code) it could be very hard to maintain it in future (in case someone add or remove description row). It would be better to change id column to text and use code as PK.
Storing description then could be solved in 2 ways:
1) Concatenate all rows containing description into 1 variable adding vbNewLine in between and store it in description field.
2) More relational but also more complex - create 2nd table for description with PK as i.e. autonumber, ForeignKey Code referring to main table. Maintenance will be here very complex. Not really worth effort.
Amount of changes in code is quite big, so sorry I'll not provide fixed code but I hope idea is clear.
BTW: The reason why description is not updated is described in your post. You are increasing id only when code is present, so every description field from first group have id = 1. The most simple fix in your code would be to create 2 update statements - One for rows with code
UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'
Second one for rows without code:
UPDATE Voice SET Description = Description + CHAR(13) + CHAR(10) + '" + v.Description + "' WHERE id= '"+id+"'

asp.net Logic to check if user already exist

I have this code to check if a user already exists, but it is not working.
For some reason system is skipping this function:
if Cadastrar_CodEmpresa = verificar("Usuario") Then
Response.Redirect("index.asp?pagina=login")
Here is the code:
if request.Form("commentForm") = "sim" Then
set verificar = conexao.execute ("select * from empresas")
Cadastrar_CodEmpresa = request.Form("CodEmpresa")
Cadastrar_Segmento = request.Form("Segmento")
Cadastrar_Endereco = request.Form("Endereco")
Cadastrar_Bairro = request.Form("Bairro")
Cadastrar_Cidade = request.Form("Cidade")
Cadastrar_CEP = request.Form("CEP")
Cadastrar_Pais = request.Form("Pais")
Cadastrar_Contato = request.Form("Contato")
Cadastrar_Telefone = request.Form("Telefone")
Cadastrar_Email = request.Form("email")
if Cadastrar_CodEmpresa = verificar("Usuario") Then
response.Redirect("index.asp?pagina=login")
Else
set cadastrar_cadastro = conexao.execute("insert into Empresas (Usuario) Values ('" & Cadastrar_CodEmpresa & "')")
End if
... some more stuff ...
End if

Access Run Time Error 3464 data type mismatch in criteria expression

What is wrong with that code? I can't figure out why I keep getting this error.
Sub renttt()
Dim rent_list As Recordset
Dim query As String
query = "SELECT * FROM (Rent INNER JOIN Movies ON Rent.Movie_ID = Movies.ID) INNER JOIN Customers ON Rent.Customer_ID = Customers.ID WHERE Rent.Movie_ID = '" & txtbxmovieID.Value & "' AND Rent.Date_Returned is Null;"
Set rent_list = CurrentDb.OpenRecordset(query)
If rent_list.RecordCount = 1 Then
rent_List.MoveFirst
txtbxname.Value = (rent_list![CusName])
txtbxsurname.Value = (rent_list![Surname])
txtbxcardID.Value = (rent_list![Id_Card_number])
txtbxaddress.Value = (rent_list![Address])
txtbxrented.Value = (rent_list![Date_Rent])
End If
End Sub

Wouldn't MovieId be a numeric? If so, no quotes:
WHERE Rent.Movie_ID = " & txtbxmovieID.Value & " AND ...

is there a way to do SELECT SCOPE_IDENTITY() in ADODB?

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("datapath") = dpath
.Fields("analysistime") = atime
.Fields("reporttime") = rtime
.Fields("lastcalib") = lcalib
.Fields("analystname") = aname
.Fields("reportname") = rname
.Fields("batchstate") = bstate
.Fields("instrument") = instrument
.Update ' stores the new record
End With
this is how i am adding records. is it possibel to do something lik ethis???:
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("datapath") = dpath
.Fields("analysistime") = atime
.Fields("reporttime") = rtime
.Fields("lastcalib") = lcalib
.Fields("analystname") = aname
.Fields("reportname") = rname
.Fields("batchstate") = bstate
.Fields("instrument") = instrument
SCOPE_IDENTITY() <----------------
.Update ' stores the new record
End With

No, there is not.
You should make an explicit INSERT statement followed by a call to SCOPE_IDENTITY in the same batch.

After you have executed the Update command, the identity will be placed in the corresponding field in the recordset. You can read it from there.
Example:
id = .Fields("id")