ThatTransportationPerson
New member
- Local time
- Today, 02:04
- Joined
- Apr 22, 2022
- Messages
- 17
Hello!
Let me start by stating that I'm pretty much a novice when it comes to Access, so please let me know if I can explain things more clearly or use different verbiage. I have an Access database that was created by someone else years ago. Its purpose was to take Access data from a piece of software (let's call it "P") and import it into an .mdb where it could be used for GIS applications. When we upgraded the "P" software approx. 3 years ago, it no longer provided Access data and therefore this Access database was rendered useless. However, I recently discovered a way to convert the "P" data back into Access and I am attempting to once again use this Access database.
Unfortunately, when I push the button to execute the VBA (to push the data to the .mdb), Access crashes. No errors. If I open Visual Basic and attempt to run the VBA, it prompts me for a Macro. Here's the code:
Does anyone have an idea of why this might be happening?
Let me start by stating that I'm pretty much a novice when it comes to Access, so please let me know if I can explain things more clearly or use different verbiage. I have an Access database that was created by someone else years ago. Its purpose was to take Access data from a piece of software (let's call it "P") and import it into an .mdb where it could be used for GIS applications. When we upgraded the "P" software approx. 3 years ago, it no longer provided Access data and therefore this Access database was rendered useless. However, I recently discovered a way to convert the "P" data back into Access and I am attempting to once again use this Access database.
Unfortunately, when I push the button to execute the VBA (to push the data to the .mdb), Access crashes. No errors. If I open Visual Basic and attempt to run the VBA, it prompts me for a Macro. Here's the code:
Code:
Private Sub UpdateFromP()
'pull data from linked P tables and update linked GIS geodatabase tables
Dim strSourceFields As String
Dim strDestFields As String
Dim rsPCIAGE As ADODB.Recordset
Dim rs As ADODB.Recordset
Set rsPCIAGE = New ADODB.Recordset
Set rs = New ADODB.Recordset
rsPCIAGE.Open "SELECT * FROM AAllAirportsAlbers ORDER BY ID;", CurrentProject.Connection, adOpenStatic, adLockPessimistic
rs.Open "SELECT Sections.ID, BranchID, [Name], Use, InspPCI, PCISource, Area, ConstDate, InspDate, Round(DateDiff('m',[ConstDate],[InspDate])/12,0) AS InspAge " & _
"FROM (SELECT DISTINCT zUser_InspectionsAllYears.ID, Condition AS InspPCI, PCISource, Date AS InspDate, Area " & _
"FROM (SELECT ID, Max([Date]) AS LastInspDate FROM zUser_InspectionsAllYears GROUP BY ID) AS Query1 INNER JOIN zUser_InspectionsAllYears ON Query1.ID=zUser_InspectionsAllYears.ID " & _
"WHERE zUser_InspectionsAllYears.Date=[LastInspDate]) AS LastInsp RIGHT JOIN ((SELECT DISTINCT zUser_MajorMRAllYears.ID, zUser_MajorMRAllYears.Date AS ConstDate " & _
"FROM (SELECT ID, Max(Date) As LastInspDate FROM zUser_InspectionsAllYears GROUP BY ID) AS Q1 RIGHT JOIN ((SELECT ID, Max(Date) AS LastConstDate FROM zUser_MajorMRAllYears " & _
"GROUP BY zUser_MajorMRAllYears.ID) AS Q2 RIGHT JOIN zUser_MajorMRAllYears ON Q2.ID = zUser_MajorMRAllYears.ID) ON Q1.ID = zUser_MajorMRAllYears.ID " & _
"WHERE (((zUser_MajorMRAllYears.Date) = [LastConstDate] And (zUser_MajorMRAllYears.Date) <= [LastInspDate]))) AS LastConst RIGHT JOIN (SELECT [Uzukzxcttnsspyqmtdko] & [SectionID] AS ID, BranchID, Name, Use " & _
"FROM [Network-Extension] RIGHT JOIN (Branch RIGHT JOIN [Section] ON Branch.[_BUNIQUEID] = [Section].[_BUNIQUEID]) ON [Network-Extension].[_NUNIQUEID] = Branch.[_NUNIQUEID]) AS Sections ON LastConst.ID = Sections.ID) ON LastInsp.ID = Sections.ID " & _
"ORDER BY Sections.ID;", CurrentProject.Connection, adOpenStatic, adLockPessimistic
While Not rsPCIAGE.EOF
rs.Find "ID='" & rsPCIAGE!ID & "'"
If Not rs.EOF Then
rsPCIAGE!Branch = rs!BranchID
rsPCIAGE!BranchName = rs![Name]
rsPCIAGE!PCI = rs!InspPCI
rsPCIAGE!Age = rs!InspAge
rsPCIAGE!Area = rs!Area
rsPCIAGE!Use = rs!Use
rsPCIAGE!LastInspec = rs!InspDate
rsPCIAGE!LastConst = rs!ConstDate
End If
rs.MoveFirst
rsPCIAGE.MoveNext
Wend
rsPCIAGE.MoveFirst 'to commit final record edits
rsPCIAGE.Close
rs.Close
CurrentDb.Execute "UPDATE AAllAirportsAlbers Set AdjPCI = PCI - FormatNumber(DateDiff('m', nz(LastInspec,0), Date()) / 12, 0) * 3, AdjAge = Age + FormatNumber(DateDiff('m', nz(LastInspec,0), Date()) / 12, 0)"
CurrentDb.Execute "UPDATE AAllAirportsAlbers Set AdjPCI = IIf(AdjPCI < 0, 0, AdjPCI)"
CurrentDb.Execute "UPDATE AAllAirportsAlbers SET RepYear = RepairYear([PCI],IIf([LastInspec]>[LastConst],DatePart('yyyy',[LastInspec]),DatePart('yyyy',[LastConst])),IIf([Use]='Runway', 70, 60))"
CurrentDb.Execute "DELETE FROM ALLBranchPCIAge"
CurrentDb.Execute "INSERT INTO AllBranchPCIAge (FAAID, Branch, Use, SumArea, AveragePCI, AverageAge, WeightedPCI, WeightedAge )" & _
"SELECT Totals.FAAID, Totals.Branch, Totals.Use, Sum(Totals.Area) AS BranchArea, Round(Avg([PCI]),0) AS BranchPCI, Round(Avg([Age]),0) AS BranchAge, " & _
"Round(Sum([PCI]*[Area])/Sum([Area]),0) AS WPCI, Round(Sum([Age]*[Area])/Sum([Area]),0) AS WAge " & _
"FROM (SELECT FAAID, Branch, Use, PCI, Age, Area FROM AAllAirportsAlbers GROUP BY FAAID, Branch, Use, PCI, Age, Area) AS Totals " & _
"GROUP BY Totals.FAAID, Totals.Branch, Totals.Use;"
strSourceFields = "ID, [Name], Condition, [_Latest], PCISource, Use, [Date], Area, FAAID"
strDestFields = "SectionID, BranchName, Condition, Latest, Source, Use, InspectionDate, Area, FAAID"
CurrentDb.Execute "DELETE FROM PaverData_InspectionsAllYears"
CurrentDb.Execute "DELETE FROM PaverData_MajorMRAllYears"
CurrentDb.Execute "INSERT INTO PaverData_InspectionsAllYears(" & strDestFields & ") SELECT " & strSourceFields & " FROM zUser_InspectionsAllYears;"
CurrentDb.Execute "INSERT INTO PaverData_MajorMRAllYears(SectionID, BranchName, Use, ConstDate, FAAID) SELECT ID, [Name], Use, [Date], FAAID FROM zUser_MajorMRAllYears;"
CalcAges
End Sub
Private Sub CalcAges()
Dim cn As ADODB.Connection
Dim rsConst As ADODB.Recordset
Dim rsInsp As ADODB.Recordset
Dim strNetwork As String
Dim strSection As String
Dim dblAge As Double
Set cn = CurrentProject.Connection
Set rsConst = New ADODB.Recordset
Set rsInsp = New ADODB.Recordset
rsInsp.Open "SELECT FAAID, SectionID, InspectionDate, Age FROM PaverData_InspectionsAllYears " & _
"ORDER BY FAAID, SectionID, InspectionDate;", cn, adOpenStatic, adLockPessimistic
While Not rsInsp.EOF
If strNetwork <> rsInsp!FAAID Or strSection <> rsInsp!SectionID Then
If rsConst.State = 1 Then
rsConst.Close
End If
rsConst.Open "SELECT FAAID, SectionID, ConstDate " & _
"FROM PaverData_MajorMRAllYears WHERE FAAID='" & rsInsp!FAAID & "' AND SectionID='" & rsInsp!SectionID & "' " & _
"ORDER BY FAAID, SectionID, ConstDate;", cn, adOpenStatic, adLockPessimistic
strNetwork = rsConst!FAAID
strSection = rsConst!SectionID
End If
While Not rsConst.EOF
If rsConst!ConstDate <= rsInsp!InspectionDate Then
dblAge = DateDiff("m", rsConst!ConstDate, rsInsp!InspectionDate) / 12
If DatePart("yyyy", rsConst!ConstDate) = DatePart("yyyy", rsInsp!InspectionDate) And dblAge >= 1 Then
dblAge = dblAge - 1
End If
End If
rsConst.MoveNext
Wend
rsInsp!Age = FormatNumber(IIf(dblAge < 1, 0, dblAge), 0)
rsInsp.Update
rsInsp.MoveNext
rsConst.MoveFirst
Wend
rsInsp.Close
End Sub
Does anyone have an idea of why this might be happening?