' 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 = "" + strText + "" 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, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" & strMyCallsign & " - Recent Logbook Entries" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "
" Print #fnoHTMLFile, "

" & strMyCallsign & " - Recent Logbook Entries

" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" 'Print #fnoHTMLFile, "" ' /Time 'Print #fnoHTMLFile, "" 'Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" ' 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, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" If Not IsNull(rstFieldData("Country")) Then strCountry = IIf(rstFieldData("Country") = "United States of America", "USA", rstFieldData("Country")) Else strCountry = "" End If Print #fnoHTMLFile, "" 'Print #fnoHTMLFile, "" ' Hh:Nn 'Print #fnoHTMLFile, "" 'Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" 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, "
 Station  Country  Date UTC  Received  Sent  Band  Mode 
" & IIf(strStationURL <> "", "" & rstFieldData("Station") & "", rstFieldData("Station")) & " " & strCountry & " " & Format(rstFieldData("StartTime"), "yyyy-mm-dd") & " " & strBand & "" & strMode & "
" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "
" Print #fnoHTMLFile, "" Print #fnoHTMLFile, "" 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), "", 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 = "" Then GetNextLoTW_ADIFRecord = False Exit Do End If If strCurLine = "" 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, "", 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