I have been working hard to clean up my code but I am still wondering why all incoming records go to the "AddNew" part of the IF statement and never to the Edit alternative. I believe that it must be because my
rs.index never really receives the value from the cell in the spreadsheet that it should use to compare to the corresponding field in the Access DB. I have named the field "rtitle" in Access and made it an index called riskIndex. I am an amateur at using debug and add watch but I tried to add watches for the variables and it appears that rs.Index is never getting the value of riskIndex but rather, "riskIndex" the string. I'm not sure about this though.
Is my syntax wrong. Please help, I have a lot of pressure on me to get this working and I'm just a newbie VB person.
Thanks!!
Here's the code:
-
Sub TestProc()
-
Dim lCount As Long
-
Dim wbResults As Workbook
-
Dim wbCodeBook As Workbook
-
-
Application.ScreenUpdating = False
-
Application.DisplayAlerts = False
-
Application.EnableEvents = False
-
-
'On Error Resume Next
-
Set wbCodeBook = ThisWorkbook
-
-
With Application.FileSearch
-
.NewSearch
-
'Change path to local conditions of risk group
-
.LookIn = "C:\Documents and Settings\basbergb\Desktop\usethisone_risk\pristine \access\IncomingRiskCandidateFiles"
-
.FileType = msoFileTypeExcelWorkbooks
-
.Filename = "*.xls"
-
-
If .Execute > 0 Then 'Workbooks in folder
-
For lCount = 1 To .FoundFiles.Count 'Loop through all.
-
'Open Workbook x and Set a Workbook variable to it
-
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
-
-
'I put some code I want to perform on each workbook between these lines
-
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''
-
'Sub DAOFromExcelToAccess()
-
'exports data from the active worksheet to a table in an Access database
-
Dim db As DAO.Database, rs As DAO.Recordset, r As Integer, Ans As Integer, myWS As Worksheet, crit As String
-
Set db = OpenDatabase("C:\Documents and Settings\basbergb\desktop\usethisone_risk\pristine \access\risk.mdb")
-
Set rs = db.OpenRecordset("CandidateRisk", dbOpenTable)
-
Set myWS = Sheets("Candidate Risk Worksheet")
-
-
Dim STRrtitle As String
-
Dim vrtIDby As Variant
-
-
'rs.Index = "riskIndex"
-
-
-
'Get rtitle in Excel
-
STRrtitle = Range("B" & 7).Value
-
-
'Get IDby in Excel
-
'vrtIDby = Range("B" & 11).Value
-
-
With rs
-
.Index = "riskIndex"
-
'Find record in database
-
.Seek "=", STRrtitle
-
End With
-
-
'if record not found in database, add it
-
-
If rs.NoMatch = True Then
-
'Record not found so create new record:
-
With rs
-
.AddNew 'create a new record
-
.Fields("rtitle") = myWS.Range("B7").Value
-
.Fields("status") = myWS.Range("K7").Value
-
.Fields("IDby") = myWS.Range("B11").Value
-
.Fields("IPT_WGID") = myWS.Range("G11").Value
-
.Fields("dateID") = myWS.Range("K11").Value
-
.Fields("riskOwner") = myWS.Range("B14").Value
-
.Fields("IPT_WGRO") = myWS.Range("G14").Value
-
.Fields("dateAssigned") = myWS.Range("K14").Value
-
.Fields("dateFirstPresented") = myWS.Range("K17").Value
-
.Fields("ifThenPerf") = myWS.Range("C19").Value
-
.Fields("sitPerf") = myWS.Range("C20").Value
-
.Fields("LH_Perf") = myWS.Range("E21").Value
-
.Fields("CQ_Perf") = myWS.Range("E22").Value
-
.Fields("RHA_Perf") = myWS.Range("F23").Value
-
.Fields("ifThenCost") = myWS.Range("C19").Value
-
.Fields("sitCost") = myWS.Range("C20").Value
-
.Fields("LH_Cost") = myWS.Range("E21").Value
-
.Fields("CQ_Cost") = myWS.Range("E22").Value
-
.Fields("RHA_Cost") = myWS.Range("F23").Value
-
.Fields("ifThenSched") = myWS.Range("C19").Value
-
.Fields("sitSched") = myWS.Range("C20").Value
-
.Fields("LH_Sched") = myWS.Range("E21").Value
-
.Fields("CQ_Sched") = myWS.Range("E22").Value
-
.Fields("RHA_Sched") = myWS.Range("F23").Value
-
.Fields("DAESriskFactor") = myWS.Range("B40").Value
-
.Fields("reqRiskBasedOn") = myWS.Range("J40").Value
-
-
.Update 'stores the new record
-
End With
-
Ans = MsgBox("Candidate Risk written to Access database", vbInformation, "Transferred Data")
-
-
Else
-
-
'Record is found so edit it
-
With rs
-
.Edit
-
.Fields("rtitle") = myWS.Range("B7").Value
-
.Fields("status") = myWS.Range("K7").Value
-
.Fields("IDby") = myWS.Range("B11").Value
-
.Fields("IPT_WGID") = myWS.Range("G11").Value
-
.Fields("dateID") = myWS.Range("K11").Value
-
.Fields("riskOwner") = myWS.Range("B14").Value
-
.Fields("IPT_WGRO") = myWS.Range("G14").Value
-
.Fields("dateAssigned") = myWS.Range("K14").Value
-
.Fields("dateFirstPresented") = myWS.Range("K17").Value
-
.Fields("ifThenPerf") = myWS.Range("C19").Value
-
.Fields("sitPerf") = myWS.Range("C20").Value
-
.Fields("LH_Perf") = myWS.Range("E21").Value
-
.Fields("CQ_Perf") = myWS.Range("E22").Value
-
.Fields("RHA_Perf") = myWS.Range("F23").Value
-
.Fields("ifThenCost") = myWS.Range("C19").Value
-
.Fields("sitCost") = myWS.Range("C20").Value
-
.Fields("LH_Cost") = myWS.Range("E21").Value
-
.Fields("CQ_Cost") = myWS.Range("E22").Value
-
.Fields("RHA_Cost") = myWS.Range("F23").Value
-
.Fields("ifThenSched") = myWS.Range("C19").Value
-
.Fields("sitSched") = myWS.Range("C20").Value
-
.Fields("LH_Sched") = myWS.Range("E21").Value
-
.Fields("CQ_Sched") = myWS.Range("E22").Value
-
.Fields("RHA_Sched") = myWS.Range("F23").Value
-
.Fields("DAESriskFactor") = myWS.Range("B40").Value
-
.Fields("reqRiskBasedOn") = myWS.Range("J40").Value
-
.Update
-
End With
-
-
-
Ans = MsgBox("Successfully edited the record", vbInformation, "Updated values")
-
End If
-
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
-
-
wbResults.Close SaveChanges:=True
-
-
Next lCount
-
End If
-
End With
-
-
On Error GoTo 0
-
Application.ScreenUpdating = True
-
Application.DisplayAlerts = True
-
Application.EnableEvents = True
-
End Sub
-
-
-
If anyone can help I cannot tell you how relieved and grateful I will be- I have been struggling with this for so long > over a week pretty much non-stop. Please let me know if I should clarify anything though I think I've been too detailed which may make it too much work for anyone to help.
Thank you in advance for your time and talent
