Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Sub UpdateAirEmissionFromTeams()
- Dim ws As Worksheet
- Dim Query As String
- Dim StartRow As Long
- Set ws = Sheet1
- ws.Activate
- StartRow = 2
- ' Query = "SELECT t2.PERIOD_YEAR ""År"", t2.PERIOD_MONTH ""Måned"", t2.TASKID ""Oppdr. nr."", " & _
- "s.name ""Verk"", pr.NAME_NB_NO ""Prosess"", se.NAME_NB_NO ""Seksjon"", l.NAME ""Lokasjon"", " & _
- "t2.SAMPLEDATEFROM ""Prøvestart"", t2.SAMPLEDATETO ""Prøvestopp"", m.NAME ""Målepunkt"", " & _
- "t2.SAMPLEID ""Prøveid"", mt.NAME_NB_NO ""Anleggsdel"", st.NAME_NB_NO ""Prøvetype"", " & _
- "t2.""Comment"" ""Kommentar"", t2.TEMPERATURE_VALUE ""Kanaltemperatur"", " & _
- "t2.AIRFLOWRATE_VALUE ""Volumstrøm [Nm3/h]"", t2.SAMPLEGASVOLUME_VALUE ""Abs. gass [Nm3]"", " & _
- "p.NAME_NB_NO ""Komponent"", t2.CONCENTRATION_VALUE ""Kons. (tot) [mg/Nm3]"", " & _
- "t2.CONCENTRATIONGAS_VALUE ""Kons. (gassf.) [mg/Nm3]"", t2.CONCENTRATIONPART_VALUE ""Kons. (part.) [mg/Nm3]"", " & _
- "t2.EMISSIONFLOWRATE_VALUE ""Rate (tot) [kg/h]"", t2.EMISSIONFLOWRATEGAS_VALUE ""Rate (gassf.) [kg/h]"", " & _
- "t2.EMISSIONFLOWRATEPART_VALUE ""Rate (part.) [kg/h]"", t2.CREATEDDATETIME ""Opprettet"", p.ORDERNUMBER ""PAH #"" " & _
- "FROM TEAMSSR.AIREMISSIONANALYSISPAHOUTPUT t2, TEAMSSR.SAMPLETYPE st, TEAMSSR.MEASUREMENTTYPE mt, " & _
- "TEAMSSR.LOCATION l, TEAMSSR.SITE s, TEAMSSR.PROCESS pr, TEAMSSR.MEASUREMENTPOINT m, TEAMSSR.SECTION se, " & _
- "TEAMSSR.POLLUTANT p " & _
- "WHERE s.name = 'Årdal' and t2.LOCATIONID = l.ID and t2.SAMPLETYPEID = st.ID " & _
- "and t2.PROCESSID = pr.ID and t2.SECTIONID = se.ID and t2.POLLUTANTID = p.ID and t2.MEASUREMENTTYPEID = mt.ID " & _
- "and t2.MEASUREMENTPOINTID = m.ID and t2.PERIOD_YEAR >= '2016'"
- Query = "SELECT t2.YEAR ""År"", t2.MONTH ""Måned"", p.NAME_NB_NO ""Komponent"", " & _
- "s.NAME ""Verk"", mp.NAME ""Målepunkt"", AVG(t2.CONCENTRATION_VALUE) ""Konsentrasjon"" " & _
- "FROM TEAMSSR.WATERDISCHARGEANALYSISOUTPUT t2, TEAMSSR.site s, TEAMSSR.pollutant p, TEAMSSR.MEASUREMENTPOINT mp " & _
- "WHERE t2.siteid = s.id and t2.pollutantid = p.id and t2.measurementpointid = mp.id " & _
- "and s.NAME_NB_NO='Årdal' and t2.samplingdate>={ts'2016-01-01 00:00:00'} " & _
- "GROUP BY t2.YEAR, t2.MONTH, p.NAME_NB_NO, s.NAME, mp.NAME ORDER BY t2.YEAR"
- Call GetDataFunc("TEAMS", Query, ws, "AirEmissionTable", "A", StartRow)
- End Sub
- Private Sub GetDataFunc(Enhet As String, Query As String, ws As Worksheet, TableName As String, TableStartColumn As String, TableStartRow As Long)
- Dim DNSname As String, UIDname As String, PWDname As String, DBQname As String
- Dim dbConnectStr As String
- Dim conn As Object: Set conn = CreateObject("ADODB.Connection")
- Dim recset As Object: Set recset = CreateObject("ADODB.Recordset")
- Dim ErrorTag As Boolean
- Dim i As Long, lastRow As Long, lastColumn As Long
- Dim arrResults As Variant
- Dim tblRange As String
- Exit Sub
- If Enhet = "TEAMS" Then
- DNSname = "TEAMS"
- UIDname = "xxx"
- PWDname = "xxx"
- DBQname = "P090.HYDRO.COM"
- Else
- ufFeilMedODBC.Show
- Exit Sub
- End If
- dbConnectStr = "DSN=" & DNSname & ";UID=" & UIDname & ";PWD=" & PWDname & ";DBQ=" & DBQname
- conn.ConnectionString = dbConnectStr
- conn.Open dbConnectStr
- conn.CommandTimeout = 999999
- recset.CursorType = 2
- recset.Open Query, conn
- For i = 0 To recset.Fields.Count - 1
- Range(TableStartColumn & TableStartRow).Offset(0, i).Value = recset.Fields(i).Name
- Next i
- ws.Range(TableStartColumn & TableStartRow + 1).CopyFromRecordset (recset)
- recset.MoveFirst
- arrResults = recset.GetRows
- lastRow = UBound(arrResults, 2) + TableStartRow + 1
- recset.Close
- lastColumn = recset.Fields.Count + Range(TableStartColumn & 1).Column - 1
- tblRange = Range(Range(TableStartColumn & TableStartRow), Cells(lastRow, lastColumn).Address).AddressLocal
- On Error Resume Next
- ws.ListObjects.Add(xlSrcRange, Range(tblRange), , xlYes).Name = TableName
- DNSname = Null
- arrResults = Null
- UIDname = Null
- PWDname = Null
- DBQname = Null
- tblRange = Null
- lastRow = Null
- lastColumn = Null
- Query = ""
- recset = Null
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement