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:
Expand|Select|Wrap|Line Numbers
- 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
Thank you in advance for your time and talent