Run - time error 3625: item not found in this collection

[BayEnder111]

Hi Guys,

First time poster on these forums, unfortunately I don't have a great deal of VBA experience.

I've basically just took over a project from somebody and I'm looking to add a field called "Change" into the database. The database then populates an Excel spreadsheet which I want the new column to be added into column "W".

I've amended the VB code as below (The relevant lines are underlined and in italics) and added the field "Change" into a table called AL Override.

However when I run the macro to populate the spreadsheet it throws up "Run-time error 3625: Item not found in this collection".

Private Function GenerateTREADataSheet(WEA)
Dim xlApp As New Excel.Application
    Dim xlWrkBk As Excel.Workbook
    Dim xlSht, xlShtOOS As Excel.Worksheet
    Dim myRec As DAO.Recordset
    Dim rowNo, rowNoOOS As Integer 'stores the row number to write data to
    Dim password As String
    Dim DomainStart As String 'stores the start of the domain name
    rowNo = 4 ' Data row for incident data enty
    rowNoOOS = 5 ' Data row for incident data enty
    Dim SQLStart, SQLEnd As String
    Dim WEAStart As Date ' stores the start date of the WEA for SQL query
    Dim WEAEnd As Date ' stores the end date of the WEA for SQL query
    Dim qdf, qdfSL9 As QueryDef
    
    'Obtain the Query to Use
    Set qdf = CurrentDb.QueryDefs("TREA TLA Performance Report Query")
'''''''''''''''''''''
    ' Get the WEA dates
    '''''''''''''''''''''
    Set WEARec = CurrentDb.OpenRecordset("WEAs")
     WEARec.MoveFirst
     With WEARec
      Do While Not .EOF
        If CInt(WEARec.Fields("WEA #").Value) = CInt(WEAName.Column(1)) Then
            WEAStart = WEARec.Fields("WEA Start Date") ' Start Date
            WEAEnd = WEARec.Fields("WEA End Date") ' End Date
            Exit Do
        Else
            .MoveNext
        End If
      Loop
      End With
    Set xlWrkBk = xlApp.Workbooks.Open(Application.CurrentProject.Path & "\Template\Incident Data v4.0 2007.xlsx")
    Set xlSht = xlWrkBk.Worksheets("Raw Incident TLA Data")
    Set xlShtConfig = xlWrkBk.Worksheets("Config")
    Set xlShtOOS = xlWrkBk.Worksheets("SL4-7 – Out of Scope Incidents")
    Set xlshtReport = xlWrkBk.Worksheets("TLA Data")
    Set xlShtSL9 = xlWrkBk.Worksheets("SL9 - Availability")
    Set xlShtSL8 = xlWrkBk.Worksheets("SL8 - Aged Incidents")
    
    xlApp.Application.DisplayAlerts = False
    xlApp.Application.ScreenUpdating = True
    
    'get the password for the sheet
     password = xlShtConfig.Cells(2, "C")
     
    ' Show spreadsheet on screen
    xlApp.Application.Visible = True
    'xlApp.Parent.Windows(0).Visible = True
    'xlWrkBk.Application.Visible = True
    
    xlSht.Unprotect password
    'Clear the template fields to ensure no hangover from last report
     xlSht.Range("B4", "F1000") = ""
     xlSht.Range("H4", "J1000") = ""
     xlSht.Range("L4", "M1000") = ""
     xlSht.Range("O4", "Q1000") = ""
     
  
     'Set the WEA
     xlshtReport.Unprotect password
     xlshtReport.Cells(1, "B") = WEA
     xlshtReport.Protect password:=password
     
     ''''''''''''''''''''
     'Start Update the TLA Times
     ''''''''''''''''''''
     
     
     'unprotect the sheet
     xlShtConfig.Unprotect password:=password
     
     'Get data from Database to calculate times
     Set appRec = CurrentDb.OpenRecordset("Applications")
     appRec.MoveFirst
     With appRec
      Do While Not .EOF
        If appRec.Fields("appName").Value = "TREA" Then
            xlShtConfig.Cells(7, "C") = 19 ' Sev 2 - 19 hours
            xlShtConfig.Cells(8, "C") = 2.5 * appRec.Fields("ServiceDay") ' Sev 3 - 3 Service Says
            xlShtConfig.Cells(9, "C") = 6 * appRec.Fields("ServiceDay") ' Sev 4 - 7 Service Days
            
            Exit Do
        Else
            .MoveNext
        End If
      Loop
      End With
     'Protect the sheet
      xlShtConfig.Protect password:=password
    
    ''''''''''''''''''''
     'End Update the TLA Times
     ''''''''''''''''''''
     
     'calculate start and end dates
    qdf.Parameters("WEA Start") = Format(WEAStart, "dd/mm/yyyy")
    qdf.Parameters("WEA End") = Format(WEAEnd, "dd/mm/yyyy")
    
    Set myRec = qdf.OpenRecordset
    
    txtSQL.Value = qdf.SQL
    
    If myRec.RecordCount <> 0 Then
         myRec.MoveFirst
         
         With myRec
           Do While Not .EOF
           
              If ((IsNull(myRec.Fields("OOS")) Or myRec.Fields("OOS") = False)) Then
                xlSht.Cells(rowNo, "B").FormulaR1C1 = myRec.Fields("Inc No") 'Incident Number
                xlSht.Cells(rowNo, "C").FormulaR1C1 = myRec.Fields("App") 'App
                xlSht.Cells(rowNo, "D").FormulaR1C1 = myRec.Fields("First Severity") 'Original Severity
                xlSht.Cells(rowNo, "E").FormulaR1C1 = myRec.Fields("Severity") ' Severity at closure
                xlSht.Cells(rowNo, "F").FormulaR1C1 = myRec.Fields("Tower Start") ' Date
                xlSht.Cells(rowNo, "H").FormulaR1C1 = myRec.Fields("Brief Description") ' Headline
                xlSht.Cells(rowNo, "I").FormulaR1C1 = myRec.Fields("Closure Tower") ' Closure Tower
                xlSht.Cells(rowNo, "J").FormulaR1C1 = myRec.Fields("Date Closed") ' Closure Date
                
                xlSht.Cells(rowNo, "L").FormulaR1C1 = myRec.Fields("hours") ' Hours in Domain
                xlSht.Cells(rowNo, "M").FormulaR1C1 = myRec.Fields("infonaf_hours") ' Hours in Domain
                xlSht.Cells(rowNo, "O").FormulaR1C1 = myRec.Fields("Pass") ' TLA
                xlSht.Cells(rowNo, "W").FormulaR1C1 = myRec.Fields("Change") ' Pass/Fail Change
                
                'Add tests for the overide values
                
                If (myRec.Fields("OR Result") <> "") Then
                  xlSht.Cells(rowNo, "P").FormulaR1C1 = myRec.Fields("OR Result") ' TLA
                  xlSht.Cells(rowNo, "L").FormulaR1C1 = myRec.Fields("orHours") + myRec.Fields("infonaf_hours") ' Hours in Domain plus infonaf
                  xlSht.Cells(rowNo, "M").FormulaR1C1 = myRec.Fields("infonaf_hours") ' Hours in Domain INFONAF
                  xlSht.Cells(rowNo, "Q").FormulaR1C1 = myRec.Fields("Reason") ' override reason
                  xlSht.Cells(rowNo, "W").FormulaR1C1 = myRec.Fields("Change") ' Pass/Fail Change
                  
                Else
                  xlSht.Cells(rowNo, "P").FormulaR1C1 = myRec.Fields("Pass") ' TLA
                End If
                rowNo = rowNo + 1
                
              Else
              'populate the Out of scope tab
                xlShtOOS.Cells(rowNoOOS, "B").FormulaR1C1 = myRec.Fields("Inc No") 'Incident Number
                xlShtOOS.Cells(rowNoOOS, "C").FormulaR1C1 = myRec.Fields("App") 'App
                xlShtOOS.Cells(rowNoOOS, "D").FormulaR1C1 = myRec.Fields("Severity") ' Severity at closure
                xlShtOOS.Cells(rowNoOOS, "E").FormulaR1C1 = myRec.Fields("Tower Start") ' Date
                xlShtOOS.Cells(rowNoOOS, "F").FormulaR1C1 = myRec.Fields("Brief Description") ' Headline
                xlShtOOS.Cells(rowNoOOS, "G").FormulaR1C1 = myRec.Fields("Closure Tower") ' Closure Tower
                xlShtOOS.Cells(rowNoOOS, "H").FormulaR1C1 = myRec.Fields("Date Closed") ' Closure Date
                xlShtOOS.Cells(rowNoOOS, "I").FormulaR1C1 = myRec.Fields("Reason") ' Reason
                rowNoOOS = rowNoOOS + 1
                
              End If
              
              .MoveNext
              
           Loop
        End With
    End If
    Set qdfSL9 = CurrentDb.QueryDefs("TREA SL9 Stats")
    'calculate start and end dates
    qdfSL9.Parameters("Week Start") = Format(WEAStart, "dd/mm/yyyy")
    qdfSL9.Parameters("Week End") = Format(WEAEnd, "dd/mm/yyyy")
    
    Set myRec = qdfSL9.OpenRecordset
    rowNo = 5
    If myRec.RecordCount <> 0 Then
         myRec.MoveFirst
         
         With myRec
           Do While Not .EOF
           
              'populate the SL9 tab
                xlShtSL9.Cells(rowNo, "B").FormulaR1C1 = myRec.Fields("Inc Ref") 'Incident Number
                xlShtSL9.Cells(rowNo, "C").FormulaR1C1 = myRec.Fields("Business Unit") ' Application
                xlShtSL9.Cells(rowNo, "D").FormulaR1C1 = myRec.Fields("Start Date & Time") ' Start Date
                xlShtSL9.Cells(rowNo, "E").FormulaR1C1 = myRec.Fields("Resolution Date & Time") ' Headline
                xlShtSL9.Cells(rowNo, "F").FormulaR1C1 = myRec.Fields("DownTime") ' Downtime
               
                rowNo = rowNo + 1
                     
              .MoveNext
              
           Loop
        End With
    End If
    
    rowNo = 5
    'Update SL8 Stats
    Set Sl8Rec = CurrentDb.OpenRecordset("TREA SL8 Stats")
     Sl8Rec.MoveFirst
     With Sl8Rec
      Do While Not .EOF
            xlShtSL8.Cells(rowNo, "B") = Sl8Rec.Fields("Inc No") ' Incident number
            xlShtSL8.Cells(rowNo, "C") = Sl8Rec.Fields("Severity") ' Severity
            xlShtSL8.Cells(rowNo, "D") = Sl8Rec.Fields("Incident Open") ' Date Raised
            xlShtSL8.Cells(rowNo, "E") = Sl8Rec.Fields("Tower Start") ' Date 1st Logged
            xlShtSL8.Cells(rowNo, "F") = Sl8Rec.Fields("Domain") ' Domain
            xlShtSL8.Cells(rowNo, "G") = Sl8Rec.Fields("Brief Description") ' Description
            xlShtSL8.Cells(rowNo, "H") = Sl8Rec.Fields("Hours") ' Service Hours in Domain
            xlShtSL8.Cells(rowNo, "I") = Sl8Rec.Fields("infonaf_hours") ' infonaf Hours in Domain
            'xlShtSL8.Cells(rowNo, "K") = Sl8Rec.Fields("Working Days") ' Service Days
            rowNo = rowNo + 1
            .MoveNext
      Loop
      End With
    
    
    xlWrkBk.SaveAs Application.CurrentProject.Path & "\Reports\TREA_IncidentData_" & Left(WEA, 5) & "_" & Format(Now, "yymmdd") & ".xlsx", FileFormat:=51
    xlWrkBk.Close SaveChanges:=False
    ' Turn prompting OFF and save the sheet with original name
    xlApp.Application.DisplayAlerts = True
    xlApp.Application.Quit
    
    ' Release objects
    Set xlSht = Nothing
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
   
    
    
End Function

Looking through the internet/ rest of the database I think I need to add this new field to a stored query within the database also?

I've found the relevant 2 queries below however they are in SQL and I'm unsure how to add them:

SELECT Mid([TREA Raw Incident Data].Domain,16,4) AS Application, [TREA Raw Incident Data].Severity, RIGHT([TREA Raw Incident Data].[TREA SL4] & [TREA Raw Incident Data].[TREA SL5] & [TREA Raw Incident Data].[TREA SL6] & [TREA Raw Incident Data].[TREA SL7] & [AL Override].[OR Result],4) AS Pass, Count([TREA Raw Incident Data].[Inc no]) AS incidents
FROM [TREA Raw Incident Data] LEFT JOIN [AL Override] ON ([TREA Raw Incident Data].[Inc no]=[AL Override].[OR Inc No]) AND (Mid([TREA Raw Incident Data].Domain,16,4)=[AL Override].[Application])
WHERE ([TREA Raw Incident Data].Tower = "TREA Accenture" And [TREA Raw Incident Data].[Date Closed] > [Week Start] And [TREA Raw Incident Data].[Date Closed] < [Week End] And ([AL Override].OOS = False Or IsNull([AL Override].OOS)))
GROUP BY Mid([TREA Raw Incident Data].Domain,16,4), [TREA Raw Incident Data].Severity, RIGHT([TREA Raw Incident Data].[TREA SL4] & [TREA Raw Incident Data].[TREA SL5] & [TREA Raw Incident Data].[TREA SL6] & [TREA Raw Incident Data].[TREA SL7] & [AL Override].[OR Result],4), [TREA Raw Incident Data].Severity, Mid([TREA Raw Incident Data].Domain,16,4);

&

SELECT Mid([TREA Raw Incident Data].Domain,15,3) AS Application, [TREA Raw Incident Data].Severity, RIGHT([TREA Raw Incident Data].[Accenture SL5] & [TREA Raw Incident Data].[Accenture SL6] & [TREA Raw Incident Data].[Accenture SL7] & [TREA Raw Incident Data].[Accenture SL8] & [AL Override].[OR Result],4) AS Pass, [TREA Raw Incident Data].[Inc no] AS incident, [TREA Raw Incident Data].[Closure Tower], [TREA Raw Incident Data].[Date Closed]
FROM [TREA Raw Incident Data] LEFT JOIN [AL Override] ON (Mid([TREA Raw Incident Data].Domain,15,3)=[AL Override].[Application]) AND ([TREA Raw Incident Data].[Inc no]=[AL Override].[OR Inc No])
WHERE ([TREA Raw Incident Data].Tower="TREA Accenture" And [TREA Raw Incident Data].[Date Closed]>[Week Start] And [TREA Raw Incident Data].[Date Closed]<[Week End] And ([AL Override].OOS=False Or IsNull([AL Override].OOS)));

Any ideas on where I'm going wrong would be greatly appreciated as I'm at a sticking point now.

Many Thanks,
Brian.

 

[BayEnder111]

Thanks a lot for that Par.

I've narrowed down what I need to do now, for some reason it won't locate the field in myRec.Fields, so it needs adding in there:

xlSht.Cells(rowNo, "W").FormulaR1C1 = myRec.Fields("Change") ' Pass/Fail Change

myRec.fields("Change") = <Item not found in this collection><ITEM collection this in found not>.

All the other fields are found in it.

The person I've took this over from has left the company is the issue.

In an ideal world I'd go through from scratch and try and rebuild it for my own knowledge and also to remove redundant fields. However I don't have the skill level or time yet.

Is there any way to find a list of the query/table names etc?

 

[par60056]

you could write a little loop.

for iField=1 to myRec.Fields.count
debug.print myRec.Fields(iField).Name
next

This will print the field names into the Immediate window of the macro debugger. You would need to put this somewhere after you open the recordset.