' Microsoft Access Basic Module
' By WD5EAE
' http://www.wd5eae.org
' -----------------------------------------------------------------------
' Exports Ham Radio Deluxe Log file to HTML
'
' -----------------------------------------------------------------------
' Updates
'   May 24th 2007: Sort by QSO date descending
'                  Includes Satellite contacts now
'                  Satellite contacts with HTML links to AMSAT web site. Need to add other satellites and links
'   July 8th 2008: GenRecentList renamed to GenerateRecentQSOLogFile. Also, if the StationURL field has a value
'                    the generated HTML now makes the Station Callsign a link

Option Compare Database
Option Explicit

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
   ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
   As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
   ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
   As Long, ByVal hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Const DO_DATA_UPDATE = True
Public Const USE_LOTWRECV_FIELD = True

Public strMDBToOpen As String
Public strADIFToOpen As String

Public ADIF_Header_Name As String
Public APP_LoTW_OWNCALL As String
Public STATION_CALLSIGN As String
Public REMOTE_CALL As String
Public BAND As String
Public QSO_MODE As String
Public QSO_DATE As String
Public TIME_ON As String
Public QSL_RCVD As String
Public QSLRDATE As String
Public DXCC As String
Public CQZ As String
Public ITUZ As String
Public IOTA As String
Public GRIDSQUARE As String
Public STATE As String
Public CNTY As String
Public RST_SENT As String
Public RST_RCVD As String
Public QSL_SENT As String
Public QSL_SENT_VIA  As String
Public QSLMSG  As String






Function ClipBoard_SetData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long

   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If

   ' Clear the Clipboard.
   X = EmptyClipboard()

   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If

   End Function

Public Function OpenHRDFileDialog() As Boolean

'Requires reference to Microsoft Office 10.0 Object Library.

   Dim fDialog As Office.FileDialog
   Dim varFile As Variant

   strMDBToOpen = ""
   'Clear listbox contents.
   'Me.FileList.RowSource = ""

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections in dialog box
      .AllowMultiSelect = False
      .InitialFileName = "\\gfs\s1\Docs\Personal Archive\Ham Radio Deluxe"
            
      'Set the title of the dialog box.
      .Title = "Please select Ham Radio Deluxe Logbook"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Access Databases", "*.MDB"

      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
      If .Show = True Then
         'Loop through each file selected and add it to our list box.
         For Each varFile In .SelectedItems
            strMDBToOpen = varFile
            'Me.FileList.AddItem varFile
            OpenHRDFileDialog = True
         Next
      Else
         OpenHRDFileDialog = False
      End If
   End With
End Function
                    
Function MakeURL(strText, strURL As String) As String
  MakeURL = "<a target=""_blank"" href=""" + strURL + """>" + strText + "</a>"
End Function

Function MakeSatURL(strSatellite As String) As String
  Dim strBaseURL_1 As String
  Dim strBaseURL_2 As String
  
  strBaseURL_1 = "http://www.amsat.org/amsat-new/satellites/satInfo.php?satID="
  strBaseURL_2 = "&retURL=/satellites/status.php"
  Select Case strSatellite
    Case "AO-51"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "1" + strBaseURL_2)
    Case "VO-52"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "2" + strBaseURL_2)
    Case "SO-50"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "4" + strBaseURL_2)
    Case "AO-27"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "7" + strBaseURL_2)
    Case "AO-16"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "11" + strBaseURL_2)
    Case "AO-7"
      MakeSatURL = MakeURL(strSatellite, strBaseURL_1 + "9" + strBaseURL_2)
    Case Else
      MakeSatURL = strSatellite
  End Select
End Function

Sub GenerateRecentQSOLogFile()
  Dim cnnDB As ADODB.Connection
  Dim intCounter As Integer
  Dim fnoHTMLFile As Integer
  Dim bolColor As Boolean
  Dim strCountry As String
  Dim strSQL As String
  Dim strStationURL As String
  Dim rstFieldData As ADODB.Recordset
  Dim strClipboardInfo As String
  Dim bolDoClipboard As Boolean
  Dim strMyCallsign As String
  Dim strBand, strMode As String
    
  
  '=====================================================
  ' SET YOUR VARS HERE
  bolDoClipboard = False
  strMyCallsign = "WD5EAE"
  '=====================================================
  
  If Not OpenHRDFileDialog Then Exit Sub
  
  bolColor = True
  
  fnoHTMLFile = FreeFile
  Open "C:\LogFile.html" For Output As #fnoHTMLFile
  Print #fnoHTMLFile, "<html xmlns=""http://www.w3.org/TR/REC-html40"">"
  Print #fnoHTMLFile, "<head>"
  Print #fnoHTMLFile, "<meta http-equiv=Content-Type content=""text/html; charset=windows-1252"">"
  Print #fnoHTMLFile, "<title>" & strMyCallsign & " - Recent Logbook Entries</title>"
  Print #fnoHTMLFile, "<style type=""text/css"" media=""all"">"
  Print #fnoHTMLFile, "<!--"
  Print #fnoHTMLFile, ".style1 { font-family: Arial, Helvetica, sans-serif;}"
  Print #fnoHTMLFile, ".odd {background-color: #CCFF99;}"
  Print #fnoHTMLFile, ".even {background-color: #FFFFCC;}"
  Print #fnoHTMLFile, "-->"
  Print #fnoHTMLFile, "</style>"
  Print #fnoHTMLFile, "<SCRIPT LANGUAGE=""JavaScript"" type=""text/javascript"">"
  Print #fnoHTMLFile, "<!--"
  Print #fnoHTMLFile, "  function PageInit() {"
  Print #fnoHTMLFile, "   if(document.getElementsByTagName){"
  Print #fnoHTMLFile, "     var table = document.getElementById(""LogEntries"");"
  Print #fnoHTMLFile, "     var rows = table.getElementsByTagName(""tr"");"
  Print #fnoHTMLFile, "     for(i = 1; i < rows.length; i++){ //manipulate rows"
  Print #fnoHTMLFile, "       if(i % 2 == 0){"
  Print #fnoHTMLFile, "         rows[i].className = ""even"";"
  Print #fnoHTMLFile, "       }else{"
  Print #fnoHTMLFile, "         rows[i].className = ""odd"";"
  Print #fnoHTMLFile, "       } // if"
  Print #fnoHTMLFile, "     } //for"
  Print #fnoHTMLFile, "   } // if"
  Print #fnoHTMLFile, "  }"
  Print #fnoHTMLFile, "-->"
  Print #fnoHTMLFile, "</script>"
  
  Print #fnoHTMLFile, "</head>"
  Print #fnoHTMLFile, "<body bgcolor=""#FFFFFF"" onload=""PageInit();"">"
  Print #fnoHTMLFile, "<div class=""style1"" align=""center"">"
  Print #fnoHTMLFile, "<h1 align=""center""><font face=""Arial, Helvetica, sans-serif"">" & strMyCallsign & " - Recent Logbook Entries</font></h1>"
  Print #fnoHTMLFile, "<!-- BEGIN CUT -->"
  Print #fnoHTMLFile, "<table id=""LogEntries"" border=2 align=""center"" cellpadding=0 cellspacing=0>"
  Print #fnoHTMLFile, "<tr align=""center"" bgcolor=""#000099"">"
  Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Station&nbsp;</strong></font></td>"
  Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Country&nbsp;</strong></font></td>"
  'Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Date UTC&nbsp;</strong></font></td>" ' /Time
  'Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Received&nbsp;</strong></font></td>"
  'Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Sent&nbsp;</strong></font></td>"
  Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Band&nbsp;</strong></font></td>"
  Print #fnoHTMLFile, "<td><font color=""white""><strong>&nbsp;Mode&nbsp;</strong></font></td>"
  Print #fnoHTMLFile, "</tr>"
  
  
   ' Initialize Connection object
   Set cnnDB = New ADODB.Connection
   ' Specify Microsoft Jet 4.0 Provider and then open the
   ' database specified in the strDBPath variable.
   With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeRead
      .Open strMDBToOpen
      
      ' Code to work with database goes here.
   strSQL = "SELECT * FROM TBL_LOGBOOK ORDER BY TBL_LOGBOOK.[StartTime] DESC"

  Set rstFieldData = New ADODB.Recordset
  With rstFieldData
   .CursorType = adOpenForwardOnly
   .LockType = adLockReadOnly
   .Open Source:=strSQL, _
      ActiveConnection:=cnnDB, _
      Options:=adCmdText
  'MsgBox rstFieldData("Station"), vbInformation, "Info"
  strClipboardInfo = ""
  For intCounter = 1 To 1000
    If rstFieldData.EOF Then Exit For
    
    ' Was this a Satellite contact? If so swap field values
    strBand = rstFieldData("BandMHZ")
    strMode = rstFieldData("Mode")
    If Trim(rstFieldData("SatName")) <> "" Then
      strBand = MakeSatURL(rstFieldData("SatName"))
      strMode = rstFieldData("SatMode")
    End If
      
    If Not IsNull(rstFieldData("StationUrl")) Then
      strStationURL = rstFieldData("StationUrl")
    Else
      strStationURL = ""
    End If

    If bolDoClipboard Then
      strClipboardInfo = strClipboardInfo + rstFieldData("Station") + " (" + strBand + "/" + strMode + "); "
    End If
    
    If (Trim(rstFieldData("ReportRecv")) <> "") And (Trim(rstFieldData("ReportSent")) <> "") Or (Trim(rstFieldData("SatName")) <> "") Then
      'Print #fnoHTMLFile, "<tr bgcolor=""#" & IIf(bolColor, "CCFF99", "FFFFCC") & """>"
      Print #fnoHTMLFile, "<tr align=""center"">"
      
      Print #fnoHTMLFile, "<td>" & IIf(strStationURL <> "", "<a href=""" & strStationURL & """ target=""_blank"">" & rstFieldData("Station") & "</a>", rstFieldData("Station")) & "</td>"
      
      If Not IsNull(rstFieldData("Country")) Then
        strCountry = IIf(rstFieldData("Country") = "United States of America", "USA", rstFieldData("Country"))
      Else
        strCountry = ""
      End If
      Print #fnoHTMLFile, "<td align=""left"">&nbsp;" & strCountry & "</td>"
      'Print #fnoHTMLFile, "<td align=""left"">&nbsp;" & Format(rstFieldData("StartTime"), "yyyy-mm-dd") & "&nbsp;</div></td>" '  Hh:Nn
      'Print #fnoHTMLFile, "<td" & rstFieldData("ReportRecv") & "</td>"
      'Print #fnoHTMLFile, "<td" & rstFieldData("ReportSent") & "</td>"
      Print #fnoHTMLFile, "<td>" & strBand & "</td>"
      Print #fnoHTMLFile, "<td>" & strMode & "</td>"
      Print #fnoHTMLFile, "</tr>"
      bolColor = Not bolColor
    End If
    rstFieldData.MoveNext
  Next
  If bolDoClipboard Then
    ClipBoard_SetData (strClipboardInfo)
    MsgBox strClipboardInfo, vbInformation, "Copied to clipboard"
  Else
    MsgBox "Export Completed", vbInformation, "Finished"
  End If
  
    End With
  End With

   ' Close Connection object and destroy object variable.
   cnnDB.Close
   Set cnnDB = Nothing
  Print #fnoHTMLFile, "    </table>"
  Print #fnoHTMLFile, "<!-- END CUT -->"
  Print #fnoHTMLFile, "</div>"
  Print #fnoHTMLFile, "</body>"
  Print #fnoHTMLFile, "</html>"
  Close #fnoHTMLFile
End Sub

Public Function OpenADIFFileDialog() As Boolean

'Requires reference to Microsoft Office 10.0 Object Library.

   Dim fDialog As Office.FileDialog
   Dim varFile As Variant

   strADIFToOpen = ""
   'Clear listbox contents.
   'Me.FileList.RowSource = ""

   'Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
   With fDialog
      'Allow user to make multiple selections in dialog box
      .AllowMultiSelect = False
      .InitialFileName = "C:\"
            
      'Set the title of the dialog box.
      .Title = "Please select the ADIF File to Process"

      'Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "ADIF Files", "*.ADI"

      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
      If .Show = True Then
         'Loop through each file selected and add it to our list box.
         For Each varFile In .SelectedItems
            strADIFToOpen = varFile
            'Me.FileList.AddItem varFile
            OpenADIFFileDialog = True
         Next
      Else
         OpenADIFFileDialog = False
      End If
   End With
End Function

Public Function ReadADIFHeader(intFileNo As Integer) As Boolean
  Dim strCurLine As String
  ADIF_Header_Name = ""
  ReadADIFHeader = False
  Do While Not EOF(intFileNo)
    Input #intFileNo, strCurLine
    If ADIF_Header_Name = "" Then ADIF_Header_Name = strCurLine
    If InStr(1, UCase(strCurLine), "<EOH>", vbTextCompare) > 0 Then
      ReadADIFHeader = True
      Exit Do
    End If
  Loop
End Function
Public Sub ClearADIFVariables()
  APP_LoTW_OWNCALL = ""
  STATION_CALLSIGN = ""
  REMOTE_CALL = "" 'IN ADIF as "CALL"
  BAND = ""
  QSO_MODE = "" 'IN ADIF as "MODE"
  QSO_DATE = ""
  TIME_ON = ""
  QSL_RCVD = ""
  QSLRDATE = ""
  DXCC = ""
  CQZ = ""
  ITUZ = ""
  IOTA = ""
  GRIDSQUARE = ""
  STATE = ""
  CNTY = ""
  RST_SENT = ""
  RST_RCVD = ""
  QSL_SENT = ""
  QSL_SENT_VIA = ""
  QSLMSG = ""
End Sub
Public Function GetNextLoTW_ADIFRecord(intFileNo) As Boolean
' Recs are split out over multiple lines
  Dim strCurLine As String
  Dim intTermPos As Integer
  Dim intLineLen As Integer
  Dim intColonPos As Integer
  Dim strADIFVarName As String
  Dim strADIFValue As String
  
  ClearADIFVariables
  GetNextLoTW_ADIFRecord = False
  Do While Not EOF(intFileNo)
    Input #intFileNo, strCurLine
    If strCurLine = "<APP_LoTW_EOF>" Then
      GetNextLoTW_ADIFRecord = False
      Exit Do
    End If
    If strCurLine = "<eor>" Then
      GetNextLoTW_ADIFRecord = True
      If Not EOF(intFileNo) Then
        Input #intFileNo, strCurLine ' Read blank line
      End If
      Exit Do
    End If
    intTermPos = InStr(1, strCurLine, ">", vbTextCompare)
    If intTermPos > 0 Then
      intLineLen = Len(strCurLine)
      intColonPos = InStr(1, strCurLine, ":", vbTextCompare)
      strADIFVarName = Mid(strCurLine, 2, intColonPos - 2)
      strADIFValue = Mid(strCurLine, intTermPos + 1, intLineLen - intTermPos)
      Select Case strADIFVarName
        Case "APP_LoTW_OWNCALL"
          APP_LoTW_OWNCALL = strADIFValue
        Case "STATION_CALLSIGN"
          STATION_CALLSIGN = strADIFValue
        Case "CALL"
          REMOTE_CALL = strADIFValue
        Case "BAND"
          BAND = strADIFValue
        Case "MODE"
          QSO_MODE = strADIFValue 'IN ADIF as "MODE"
        Case "QSO_DATE"
          QSO_DATE = strADIFValue
        Case "TIME_ON"
          TIME_ON = strADIFValue
        Case "QSL_RCVD"
          QSL_RCVD = strADIFValue
        Case "QSLRDATE"
          QSLRDATE = strADIFValue
        Case "DXCC"
          DXCC = strADIFValue
        Case "CQZ"
          CQZ = strADIFValue
        Case "ITUZ"
          ITUZ = strADIFValue
        Case "IOTA"
          IOTA = strADIFValue
        Case "GRIDSQUARE"
          GRIDSQUARE = strADIFValue
        Case "STATE"
          STATE = strADIFValue
        Case "CNTY"
          CNTY = strADIFValue
        Case Else
          Debug.Print "Unknown ADIF variable found: " + strADIFVarName
        End Select
    End If
  Loop
End Function

Sub Import_LoTW_ADIF()
  Dim fnoADIFFile As Integer
  Dim strCurLine As String
  Dim strSQL As String
  Dim cnnDB As ADODB.Connection
  Dim rstHRDFieldData As ADODB.Recordset
  Dim strQSODateTime As String
  Dim intTotalRecsProcess As Integer
  Dim intTotalQSLs As Integer
  
  intTotalRecsProcess = 0
  intTotalQSLs = 0
  
  'Select the ADIF file to process
  If Not OpenADIFFileDialog Then
    MsgBox "No ADIF File Selected. Exiting routine...", vbCritical, "Error"
    Exit Sub
  End If
  
  'Select the HRD Access file to update
  If Not OpenHRDFileDialog Then
    MsgBox "No HRD Datafile Selected. Exiting routine...", vbCritical, "Error"
    Exit Sub
  End If

  fnoADIFFile = FreeFile
  Open strADIFToOpen For Input As #fnoADIFFile
  
  If ReadADIFHeader(fnoADIFFile) Then
    
    If InStr(1, ADIF_Header_Name, "Logbook of the World", vbTextCompare) = 0 Then
      Close #fnoADIFFile
      MsgBox "The file does not appear to be an ARRL LoTW ADIF file. Processing will not continue", vbCritical, "ADIF Error"
      Exit Sub
    End If
    
    ' Initialize Connection object
    Set cnnDB = New ADODB.Connection
    ' Specify Microsoft Jet 4.0 Provider and then open the
    ' database specified in the strDBPath variable.
    With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeReadWrite
      .Open strMDBToOpen
    End With
    'Input #fnoADIFFile, strCurLine
    'MsgBox strCurLine
    Do While Not EOF(fnoADIFFile)
      If GetNextLoTW_ADIFRecord(fnoADIFFile) Then
        intTotalRecsProcess = intTotalRecsProcess + 1
        If QSL_RCVD = "Y" Then
          strQSODateTime = Mid(QSO_DATE, 5, 2) + "/" + Mid(QSO_DATE, 7, 2) + "/" + Mid(QSO_DATE, 1, 4) + _
                           " " + Mid(TIME_ON, 1, 2) + ":" + Mid(TIME_ON, 3, 2) + ":" + Mid(TIME_ON, 5, 2)
          strSQL = "SELECT * FROM TBL_LOGBOOK WHERE " + _
                   "([Station]=""" + REMOTE_CALL + """ AND " + _
                   "((TBL_LOGBOOK.BandMHz)=""" + LCase(BAND) + """) AND " + _
                   "((TBL_LOGBOOK.StartTime)=#" + strQSODateTime + "#));"
              'WHERE (((TBL_LOGBOOK.Station)="W3LR") AND ((TBL_LOGBOOK.[BandMHz])="160m"));
                   '"((TBL_LOGBOOK.Mode)=""" + QSO_MODE + """)) AND " + _

          Set rstHRDFieldData = New ADODB.Recordset
          rstHRDFieldData.CursorType = adOpenKeyset
          rstHRDFieldData.LockType = adLockOptimistic
          rstHRDFieldData.Open strSQL, cnnDB, adOpenStatic, adLockOptimistic, adCmdText
          'rstHRDFieldData.Update
          
          ' We should find 1, and 1 ONLY, record with the "WHERE" SQL parameters provide above
          If rstHRDFieldData.RecordCount = 1 Then
            'Debug.Print "OK" + rstHRDFieldData("Station")
            intTotalQSLs = intTotalQSLs + 1
            If DO_DATA_UPDATE Then
              If USE_LOTWRECV_FIELD Then
                rstHRDFieldData("LoTWRecv").Value = "Y"
              Else
                rstHRDFieldData("Custom6").Value = QSLRDATE
              End If
              If (GRIDSQUARE <> "") And (IsNull(rstHRDFieldData("Locator"))) Then
                ' Update GRIDSQUARE with value from LoTW if HRD value is not present
                 rstHRDFieldData("Locator").Value = GRIDSQUARE
                Debug.Print "Locator information added for " + rstHRDFieldData("Station")
              End If
              rstHRDFieldData.Update
            End If
          Else
            If rstHRDFieldData.RecordCount > 1 Then
              Debug.Print "Too  many records found for: " + rstHRDFieldData("Station")
            Else
              ' Record not found (should never occur if HRD generated the LoTW upload)
              Debug.Print "NOT FOUND: " + REMOTE_CALL
            End If
          End If ' rstHRDFieldData.RecordCount = 1
          Set rstHRDFieldData = Nothing
        End If ' QSL_RCVD = "Y"
      End If ' GetNextLoTW_ADIFRecord(fnoADIFFile)
    Loop
    cnnDB.Close
    Set cnnDB = Nothing
    MsgBox "Total Records: " + Str(intTotalRecsProcess) + vbCrLf + "QSLs Found: " + Str(intTotalQSLs), vbInformation, "Processing Completed..."
  End If ' ReadADIFHeader(fnoADIFFile)
  ' Always...
  Close #fnoADIFFile
End Sub

Public Function GetNext_eQSL_ADIFRecord(intFileNo) As Boolean
' Recs are on a single line, 1 rec per textfile line
  Dim strCurLine As String
  Dim intTermPos As Integer
  Dim intLineLen As Integer
  Dim intColonPos As Integer
  Dim intCloseAttrPos As Integer
  Dim intCurRecPos As Integer
  Dim strADIFRec As String
  Dim strValueLen As String
  Dim strADIFVarName As String
  Dim strADIFValue As String
  
  ClearADIFVariables
  GetNext_eQSL_ADIFRecord = False
  strADIFRec = ""
  Line Input #intFileNo, strCurLine
  strADIFRec = strCurLine
  ' Dump the 8:D eQSL.cc uses since, yeah, we know it's a date cause it's a date value.
  If InStr(1, strCurLine, "<EOR>", vbTextCompare) <> 0 Then GetNext_eQSL_ADIFRecord = True
  Replace strADIFRec, ":8:D>", ":8>", 1, -1, vbTextCompare
  intCurRecPos = 2
  While Mid(strADIFRec, intCurRecPos, 4) <> "EOR>"
    intColonPos = InStr(intCurRecPos, strADIFRec, ":", vbTextCompare)
    intCloseAttrPos = InStr(intColonPos, strADIFRec, ">", vbTextCompare)
    strValueLen = Mid(strADIFRec, intColonPos + 1, intCloseAttrPos - intColonPos - 1)
    strADIFVarName = Mid(strADIFRec, intCurRecPos, intColonPos - intCurRecPos)
    strADIFValue = Mid(strADIFRec, intCloseAttrPos + 1, Val(strValueLen))
    Select Case strADIFVarName
    Case "CALL"
      REMOTE_CALL = strADIFValue
    Case "QSO_DATE"
      QSO_DATE = strADIFValue
    Case "TIME_ON"
      TIME_ON = strADIFValue
    Case "BAND"
      BAND = strADIFValue
    Case "MODE"
      QSO_MODE = strADIFValue 'IN ADIF as "MODE"
    Case "RST_SENT"
      RST_SENT = strADIFValue 'IN ADIF as "MODE"
    Case "RST_RCVD"
      RST_RCVD = strADIFValue 'IN ADIF as "MODE"
    Case "QSL_SENT"
      QSL_SENT = strADIFValue
    Case "QSL_SENT_VIA"
      QSL_SENT_VIA = strADIFValue
    Case "QSLMSG"
      QSLMSG = strADIFValue
    Case Else
      Debug.Print "Unknown ADIF variable found: " + strADIFVarName
    End Select
    intCurRecPos = intCloseAttrPos + Val(strValueLen) + 2
  Wend
End Function


Sub Import_eQSL_ADIF()
  Dim fnoADIFFile As Integer
  Dim fnoReportFile As Integer
  Dim strCurLine As String
  Dim strSQL As String
  Dim cnnDB As ADODB.Connection
  Dim rstHRDFieldData As ADODB.Recordset
  Dim strTempTime As String
  Dim strQSODateTime1 As String
  Dim strQSODateTime2 As String
  Dim intTotalRecsProcess As Integer
  Dim intTotalQSLs As Integer
  
  intTotalRecsProcess = 0
  intTotalQSLs = 0
  
  'Select the ADIF file to process
  If Not OpenADIFFileDialog Then
    MsgBox "No ADIF File Selected. Exiting routine...", vbCritical, "Error"
    Exit Sub
  End If
  
  'Select the HRD Access file to update
  If Not OpenHRDFileDialog Then
    MsgBox "No HRD Datafile Selected. Exiting routine...", vbCritical, "Error"
    Exit Sub
  End If

  fnoADIFFile = FreeFile
  Open strADIFToOpen For Input As #fnoADIFFile

  If ReadADIFHeader(fnoADIFFile) Then
    
    If InStr(1, ADIF_Header_Name, "ADIF 2 Export from eQSL.cc", vbTextCompare) = 0 Then
      Close #fnoADIFFile
      MsgBox "The file does not appear to be an eQSL.cc ADIF file. Processing will not continue", vbCritical, "ADIF Error"
      Exit Sub
    End If
    
    ' Initialize Connection object
    Set cnnDB = New ADODB.Connection
    ' Specify Microsoft Jet 4.0 Provider and then open the
    ' database specified in the strDBPath variable.
    With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeReadWrite
      .Open strMDBToOpen
    End With
    'Input #fnoADIFFile, strCurLine
    'MsgBox strCurLine
    fnoReportFile = FreeFile
    Open "C:\eQSLcc_Report.txt" For Output As #fnoReportFile
    
    Do While Not EOF(fnoADIFFile)
      If GetNext_eQSL_ADIFRecord(fnoADIFFile) Then
        intTotalRecsProcess = intTotalRecsProcess + 1
        strTempTime = ""
        'eQSL date/times do not come back the same as you sent them. they apparently come back
        'as whatever date/time the sender sends...
        'subtract a minute to the possible HRD log time
        'strQSODateTime1 = Mid(QSO_DATE, 5, 2) + "/" + Mid(QSO_DATE, 7, 2) + "/" + Mid(QSO_DATE, 1, 4) + _
        '                 " " & DateAdd("n", -5, TimeValue(Mid(TIME_ON, 1, 2) + ":" + Mid(TIME_ON, 3, 2) + ":00"))
                         
        strQSODateTime1 = DateAdd("n", -5, DateValue(Mid(QSO_DATE, 5, 2) + "/" + Mid(QSO_DATE, 7, 2) + "/" + Mid(QSO_DATE, 1, 4)) + _
                                   TimeValue(Mid(TIME_ON, 1, 2) + ":" + Mid(TIME_ON, 3, 2) + ":00"))
                                   
        'add a minute to the possible HRD log time
        strQSODateTime2 = DateAdd("n", 5, DateValue(Mid(QSO_DATE, 5, 2) + "/" + Mid(QSO_DATE, 7, 2) + "/" + Mid(QSO_DATE, 1, 4)) + _
                                   TimeValue(Mid(TIME_ON, 1, 2) + ":" + Mid(TIME_ON, 3, 2) + ":00"))
        
        strSQL = "SELECT * FROM TBL_LOGBOOK WHERE " + _
                 "([Station]=""" + REMOTE_CALL + """ AND " + _
                 "((TBL_LOGBOOK.BandMHz)=""" + LCase(BAND) + """) AND " + _
                 "(((TBL_LOGBOOK.StartTime)>=#" + strQSODateTime1 + "#) AND " + _
                 "((TBL_LOGBOOK.StartTime)<=#" + strQSODateTime2 + "#)));"
            'WHERE (((TBL_LOGBOOK.Station)="W3LR") AND ((TBL_LOGBOOK.[BandMHz])="160m"));
                 '"((TBL_LOGBOOK.Mode)=""" + QSO_MODE + """)) AND " + _

        Set rstHRDFieldData = New ADODB.Recordset
        rstHRDFieldData.CursorType = adOpenKeyset
        rstHRDFieldData.LockType = adLockOptimistic
        rstHRDFieldData.Open strSQL, cnnDB, adOpenStatic, adLockOptimistic, adCmdText
        'rstHRDFieldData.Update
          
        ' We should find 1, and 1 ONLY, record with the "WHERE" SQL parameters provide above
        If rstHRDFieldData.RecordCount = 1 Then
          Debug.Print "OK, located matching record for " + rstHRDFieldData("Station")
          'Print #fnoReportFile, "OK " + rstHRDFieldData("Station")
          intTotalQSLs = intTotalQSLs + 1
          If DO_DATA_UPDATE Then
            rstHRDFieldData("eQSLRecv").Value = "Y"
            rstHRDFieldData.Update
          End If
        Else
          If rstHRDFieldData.RecordCount > 1 Then
            Print #fnoReportFile, "Too  many records found for: " + rstHRDFieldData("Station")
            Debug.Print "Too  many records found for: " + rstHRDFieldData("Station")
          Else
            ' Record not found (should never occur if HRD generated the LoTW upload)
            Print #fnoReportFile, "Could not match: " + REMOTE_CALL + " " + Mid(QSO_DATE, 5, 2) + _
                                  "/" + Mid(QSO_DATE, 7, 2) + "/" + Mid(QSO_DATE, 1, 4) + _
                                  " " & Mid(TIME_ON, 1, 2) + ":" + Mid(TIME_ON, 3, 2) + ":00  " + BAND + "/" + QSO_MODE
            Debug.Print "Could not match: " + REMOTE_CALL
          End If
        End If ' rstHRDFieldData.RecordCount = 1
        Set rstHRDFieldData = Nothing
      End If ' GetNext_eQSL_ADIFRecord(fnoADIFFile)
    Loop
    cnnDB.Close
    Set cnnDB = Nothing
    MsgBox "Total Records: " + Str(intTotalRecsProcess) + vbCrLf + "QSLs Found: " + Str(intTotalQSLs), vbInformation, "Processing Completed..."
    Close #fnoReportFile
  End If ' ReadADIFHeader(fnoADIFFile)
  ' Always...
  Close #fnoADIFFile
End Sub