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.
I tried to highlight the most relevant code ( I hope the color works) I wanted to point to the code that's most relevant because I realize that I'm asking a lot for someone to look at so much code.
Thanks very much!!
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
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.
I tried to highlight the most relevant code ( I hope the color works) I wanted to point to the code that's most relevant because I realize that I'm asking a lot for someone to look at so much code.
Thanks very much!!
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