3a.) Example of visualbasic module in Access to create HTML files with Oil & Gas Inventory Details

Option Compare Database
Option Explicit
Public Sub OilGas_Details_Public()

'****** Creates O&G Details HTML file on GMC server for transfer to FBX server.       ******'

'****** this module builds a parameter query that selects all APIs for the selected   ******'
'****** data type then prints the appropriate details in HTML.  A loop rolls thru all ******'
'****** active tables.  Currently samples with no APIs are not selected for display   ******'
'****** in the HTML files.  Wells with no AOGCC Well Header are included in the HTML. ******'
'****** This code has no subdirectory and file management -- just file overwriting.   ******'
'****** Query 1 uses tables [ltbl_API_by_TABLE] and [Wells - Public Header Data] to   ******'
'******      locate all wells with inventory materials.                               ******'
'****** Query 2 uses table [ltbl_API_by_TABLE] to find each material for that well.   ******'
'****** Query 3 uses all well materials tables, [Wells - Public Header Data],         ******'
'******      [ltbl_types_OilGas], and [ltbl_Methods_OilGas_Processed] to find all samples ******'
'****** for each materials type for that particular well.                             ******'

'****** INPUT QUERY 1:                                                                ******'
'****** (0)ltbl_API_by_TABLE.SOURCE_TABLE (1)ltbl_TABLE_Html_Switch.Table_Label       ******'
'****** (2)ltbl_TABLE_Html_Switch.Processed_Flag (3)ltbl_TABLE_Html_Switch.Publish_Flag ******'
'****** (4)ltbl_TABLE_Html_Switch.Other_Comments (5)ltbl_TABLE_Html_Switch.Count_Label ******'

'****** INPUT QUERY 2:                                                                ******'
'****** (0)ltbl_API_by_TABLE.API (1)ltbl_API_by_TABLE.SOURCE_TABLE                    ******'
'****** (2)tbl_PUBLICATIONS.Publication_Number (3)tbl_PUBLICATIONS.Url                ******'

'****** INPUT QUERY 3:                                                                ******'
'****** (0)*.Collection (1)*.API (2)[Wells - Public Header Data].WellName             ******'
'****** (3)[Wells - Public Header Data].WellNumber (4)*.Top (5)*.Bottom               ******'
'****** (6)ltbl_types_OilGas.Category (7)ltbl_Methods_OilGas_Processed.DESCRIPTION    ******'
'****** (8)strField * defined in switch table *                                       ******'

'****** MODIFICATIONS                                                                 ******'
'****** 4/21/2010 'Added Shell command below - runs a .bat file to erase html files   ******'
'******            RetVal = Shell("F:\Databases\Bat\eraseallwellhtml_public.bat", 1) *****'
 
'****** Define data types ******
Dim MyDB           As Database
Dim MyRS           As Recordset
Dim MyRS2          As Recordset
Dim MyRS3          As Recordset

Dim strAPI         As String
Dim strField       As String
Dim strLabel       As String
Dim strRootPath    As String
Dim strSamples     As String
Dim strSavePath    As String
Dim strSaveFile    As String
Dim strSQLAPI      As String
Dim strSQLDetails  As String
Dim strSQLtype     As String
Dim strTable       As String
Dim strText        As String
Dim strType        As String
Dim x              As Integer
Dim Count          As Integer
Dim valAPI         As String
Dim valBott        As String
Dim valColl        As String
Dim valOther       As String
Dim valTop         As String
Dim valType        As String
Dim valWell        As String
Dim strTest        As String
Dim RetVal          As String

'***** RUN BAT FILE TO ERASE ALL .HTML FILES *****'
RetVal = Shell("F:\Databases\Bat\eraseallwellhtml_public.bat", 1)

'**** HTML local save path *****'
strRootPath = "F:\Google~1\curren~1\public\details\oilgas~1\"

'**** select distinct query of the oil & gas data types *****'
Set MyDB = CurrentDb
strSQLtype = "SELECT DISTINCT ltbl_API_by_TABLE.SOURCE_TABLE, ltbl_TABLE_Html_Switch.Table_Label, ltbl_TABLE_Html_Switch.Processed_Flag, ltbl_TABLE_Html_Switch.Publish_Flag, ltbl_TABLE_Html_Switch.Other_Comments, ltbl_TABLE_Html_Switch.Count_Label FROM ltbl_TABLE_Html_Switch INNER JOIN ltbl_API_by_TABLE ON ltbl_TABLE_Html_Switch.Table_Name = ltbl_API_by_TABLE.SOURCE_TABLE WHERE (((ltbl_TABLE_Html_Switch.Publish_Flag) <> False)) ORDER BY ltbl_API_by_TABLE.SOURCE_TABLE;"

'****** Use for debugging output ******'
'Open "F:\google~1\curren~1\oilgas_public_html_debug.txt" For Output Shared As #1
'Print #1, strSQLtype

Set MyRS = MyDB.OpenRecordset(strSQLtype)

'****** Begin Data Type Loop ******'
With MyRS
   Do Until .EOF
      
      strSavePath = strRootPath & LCase(Mid(MyRS.Fields(0), 5)) & "\"
      strTable = MyRS.Fields(0)
      
      '****** Look for Additional Field for Details Table ******
      If IsNull(MyRS.Fields(4)) Then strField = "" Else strField = ", " & strTable & "." & MyRS.Fields(4)
      If IsNull(MyRS.Fields(4)) Then strLabel = "(Not used)" Else strLabel = MyRS.Fields(4)
'Print #1, strSavePath & " " & strTable & " " & strField

      '****** Open Query using type to find Unique APIs with that data type ******'
      strSQLAPI = "SELECT DISTINCT ltbl_API_by_TABLE.API, ltbl_API_by_TABLE.SOURCE_TABLE FROM ltbl_API_by_TABLE WHERE (((ltbl_API_by_TABLE.API) Is Not Null) AND ((ltbl_API_by_TABLE.SOURCE_TABLE)='" & MyRS.Fields(0) & "')) ORDER BY ltbl_API_by_TABLE.API;"
'Print #1, strSQLAPI
      Set MyRS2 = MyDB.OpenRecordset(strSQLAPI)

      '****** Begin Unique APIs within Each Data Type Loop ******'
      With MyRS2
         Do Until .EOF And MyRS.Fields(0) <> "tbl_DATAREPORTINDEX"
            
            x = 0
            strSaveFile = strSavePath & MyRS2.Fields(0) & "_" & LCase(Mid(MyRS.Fields(0), 5)) & ".html"
            strAPI = MyRS2.Fields(0)
'Print #1, strSaveFile
'Print #1, strAPI
            Open strSaveFile For Output Shared As #2
    
            '****** Define an SQL statement to find data type details for each API ******'
            strSQLDetails = "SELECT " & strTable & ".Collection, " & strTable & ".API, [Wells - Public Header Data].WellName, [Wells - Public Header Data].WellNumber, " & strTable & ".Top, " & strTable & ".Bottom, ltbl_types_OilGas.Category, ltbl_Methods_OilGas_Processed.DESCRIPTION" & strField & " FROM (ltbl_Methods_OilGas_Processed RIGHT JOIN (ltbl_types_OilGas RIGHT JOIN " & strTable & " ON ltbl_types_OilGas.TYPE = " & strTable & ".Type) ON ltbl_Methods_OilGas_Processed.METHOD = " & strTable & ".Method) LEFT JOIN [Wells - Public Header Data] ON " & strTable & ".API = [Wells - Public Header Data].API_WellNo WHERE (((" & strTable & ".API) = '" & strAPI & "')) ORDER BY " & strTable & ".Collection, [Wells - Public Header Data].WellName, [Wells - Public Header Data].WellNumber, " & strTable & ".Top;"
'Print #1, strSQLDetails

            Set MyRS3 = MyDB.OpenRecordset(strSQLDetails)

            '****** Begin Data type details for each Well Loop ******'
            
            If IsNull(MyRS3.Fields(1)) Then valAPI = "&nbsp" Else valAPI = MyRS3.Fields(1)
            If IsNull(MyRS3.Fields(2)) Then valWell = "No Name" Else valWell = MyRS3.Fields(2) & " " & MyRS3.Fields(3)
            strSamples = MyRS.Fields(5)
            If MyRS.Fields(2) Then strType = "Source" Else strType = "Type"
            Count = MyRS3.RecordCount
            
            '****** HTML Header Code ******
            Print #2, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"""
            Print #2, "<html>"
            Print #2, "<head>"
            Print #2, "<title>Alaska Oil and Gas " & MyRS.Fields(1) & " Inventory for Well " & valAPI & "</title>"
            Print #2, "<meta name=""generator"" content=""Bluefish 1.0.7"">"
            Print #2, "<meta name=""author"" content=""Kurt Johnson, State of Alaska, DGGS"">"
            Print #2, "<meta name=""date"" content=""2010-04-01T10:11:13-0900"">"
            Print #2, "<meta name=""copyright"" content=""State of Alaska (2010)"">"
            Print #2, "<meta name=""keywords"" content=""Oil Gas"">"
            Print #2, "<meta name=""Description"" content=""Alaska Oil And Gas Materials Inventory"">"
            Print #2, "<meta name=""ROBOTS"" content=""NOINDEX, NOFOLLOW"">"
            Print #2, "<meta http-equiv=""content-type"" content=""text/html charset=UTF-8"">"
            Print #2, "<meta http-equiv=""content-type"" content=""application/xhtml+xml charset=UTF-8"">"
            Print #2, "<meta http-equiv=""content-style-type"" content=""text/css"">"
            Print #2, "<meta http-equiv=""expires"" content=""0"">"
            Print #2, "<link type=""Text / css"" rel=""stylesheet"" media=""all"" href=""../oilgas.css"" />"
            Print #2, "</head>"
            Print #2, "<body>"
            Print #2, "<div id=""main-content"">"
            Print #2, "   <table width=""600"" cellspacing=""0"" cellpadding=""3"">"
            Print #2, "      <tr>"
            Print #2, "         <td colspan=""5"" align=""center""><IMG src=""../../../images/oilandgasinventoryheader.png"" width=""381"" height=""60""></td>"
            Print #2, "      </tr>"
            Print #2, "      <tr>"
            Print #2, "         <td colspan=""5"" align=""center"" class=""title"">" & MyRS.Fields(1) & "</td>"
            Print #2, "      </tr>"
            Print #2, "      <tr class=""header"">"
            Print #2, "         <th  style=""font-size : large;"" colspan=""4"" align=""Left"">" & valWell & "</th>"
            Print #2, "         <th align=""Right"">" & valAPI & "</th>"
            Print #2, "      </tr>"
            Print #2, "      <tr class=""header"">"
            Print #2, "        <td colspan=""2""><b>" & strSamples & "</b> " & Count & "</td>"
            Print #2, "        <td colspan=""3"" align=""right""><a target=""_blank"" href=""http://www.dggs.alaska.gov/gmc_inventory/google_earth/html/oilandgas-details-meta.html"">Details Explanation</a></td>"
            Print #2, "      </tr>"
            Print #2, "      <tr style=""font-weight : bold;"">"
            Print #2, "         <td width=""140"">" & strType & "</td>"
            Print #2, "         <td width=""60"" align=""right"">Top</td>"
            Print #2, "         <td width=""60"" align=""right"">Bottom</td>"
            Print #2, "         <td width=""150"">&nbsp; &nbsp; Donor</td>"
            Print #2, "         <td width=""190"">" & strLabel & "</td>"
            Print #2, "      </tr>"
            
            With MyRS3
               Do Until .EOF
'Print #1, MyRS3.Fields(0) & " ""MyRS3.Fields(1) & " ""MyRS3.Fields(2) & " ""MyRS3.Fields(3) & " " & MyRS3.Fields(4) & " ""MyRS3.Fields(5) & " ""MyRS3.Fields(6) & " ""MyRS3.Fields(7)
                  x = x + 1
                  If IsNull(MyRS3.Fields(0)) Then valColl = "&nbsp;" Else valColl = MyRS3.Fields(0)
                  If IsNull(MyRS3.Fields(4)) Then valTop = "&nbsp;" Else valTop = MyRS3.Fields(4)
                  If IsNull(MyRS3.Fields(5)) Then valBott = "&nbsp;" Else valBott = MyRS3.Fields(5)
                  If IsNull(MyRS3.Fields(6)) Then valType = "&nbsp;" Else valType = StrConv(MyRS3.Fields(6), vbProperCase)
                  If IsNull(MyRS.Fields(4)) Then
                     valOther = "&nbsp"
                  ElseIf MyRS.Fields(4) = "Year" Then
                     valOther = Format(MyRS3.Fields(8), "mm/yyyy")
                  ElseIf IsNull(MyRS3.Fields(8)) Then
                        valOther = "&nbsp;"
                     Else
                        valOther = MyRS3.Fields(8)
                  End If
                 
'Print #1, strTable & " " & strOther

                  '******* HTML Data Rows *****
                  If x Mod 2 Then
                     Print #2, "      <tr class=""oddrow"">" 'odd number
                  Else
                     Print #2, "      <tr>" 'even number
                  End If
                  
                  Print #2, "        <td>" & valType & "</td>"
                  Print #2, "        <td align=""right"">" & valTop & "</td>"
                  Print #2, "        <td align=""right"">" & valBott & "</td>"
                  Print #2, "        <td>&nbsp; &nbsp; " & valColl & "</td>"
                  Print #2, "        <td>" & valOther & "</td>"
                  Print #2, "      </tr>"
                  
                  .MoveNext
               Loop
            End With
            
            '****** HTML Close ******
            Print #2, "  </table>"
            Print #2, "  <div id=""footer"">"
            Print #2, "    <p><a target=""_blank"" href=""http://www.dggs.alaska.gov/gmc_inventory/google_earth/html/gmc_advisory.html"">Reality Check</a>: Please contact the GMC staff to confirm that our released sample inventory will meet your research requirements.</p>"
            Print #2, "    <p>The GMC <em>welcomes any documented corrections</em> or additions to improve these data.</p>"
            Print #2, "    <ul id =""footer-menu"">"
            Print #2, "      <li><a target=""_blank"" href=""http://www.dggs.alaska.gov/index.php?link=gmc_overview&menu_link=gmc"">GMC</a> &#8226; </li>"
            Print #2, "      <li><a target=""_blank"" href=""http://www.dggs.alaska.gov/index.php?link=contact_form&menu_link=gmc&recipient=ken_papp"">Contact</a> &#8226; </li>"
            Print #2, "      <li><a target=""_blank"" href=""http://dnr.alaska.gov/shared/notices/copyright.htm"">Copyright</a> &#8226; </li>"
            Print #2, "      <li><a target=""_blank"" href=""http://dnr.alaska.gov/shared/notices/privacy.htm"">Privacy</a></li>"
            Print #2, "    </ul>"
            Print #2, "</div></div>"
            Print #2, "</body>"
            Print #2, "</html>"
      
            Close #2

           .MoveNext
         Loop
      End With


      .MoveNext
   Loop
End With
Close #1

'******** Close Down Module ********'
MyRS.Close
Set MyDB = Nothing
Set MyRS = Nothing
Set MyRS2 = Nothing
Set MyRS3 = Nothing

'****** turn on action query warnings ******'
DoCmd.SetWarnings True

End Sub