[VBA] Export access table into one or more worksheets if row count over 65535

https://github.com/walter426/VbaUtilities/

'Export a table to one or more worksheets in case row count over 65535
Public Function ExportTblToSht(Wb_path, Tbl_name As String, sht_name As String) As String
    On Error GoTo Err_ExportTblToSht
   
    Dim FailedReason As String

    If TableExist(Tbl_name) = False Then
        FailedReason = Tbl_name & " does not exist"
        GoTo Exit_ExportTblToSht
    End If

   
    If Len(Dir(Wb_path)) = 0 Then
        Dim oExcel As Excel.Application
        Set oExcel = CreateObject("Excel.Application")
   
        With oExcel
            Dim oWb As Workbook
            Set oWb = .Workbooks.Add
           
           
            With oWb
                .SaveAs Wb_path
                .Close
            End With 'oWb_DailyRpt
           
            .Quit
           
        End With 'oExcel
       
        Set oExcel = Nothing
       
    End If
   
   
    Dim MaxRowPerSht As Long
    Dim RecordCount As Long
       
    MaxRowPerSht = 65534
    RecordCount = Table_RecordCount(Tbl_name)
   
   
    If RecordCount <= 0 Then
        GoTo Exit_ExportTblToSht
   
    ElseIf RecordCount <= MaxRowPerSht Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_name, Wb_path, True, sht_name
   
    Else
        'handle error msg, "File sharing lock count exceeded. Increase MaxLocksPerFile registry entry"
        DAO.DBEngine.SetOption dbMaxLocksPerFile, 40000
       
       
        Dim Tbl_COPY_name As String
        Tbl_COPY_name = Tbl_name & "_COPY"
       
        DelTable (Tbl_COPY_name)
       
        Dim SQL_cmd As String

        SQL_cmd = "SELECT * " & vbCrLf & _
                    "INTO [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "FROM [" & Tbl_name & "]" & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
        SQL_cmd = "ALTER TABLE [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "ADD record_idx COUNTER " & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
        Dim ShtCount As Integer
        Dim sht_idx As Integer
        Dim Sht_part_name As String
        Dim Tbl_part_name As String
       
        ShtCount = Int(RecordCount / MaxRowPerSht)
       
        For sht_idx = 0 To ShtCount
            Sht_part_name = sht_name
           
            If sht_idx > 0 Then
                Sht_part_name = Sht_part_name & "_" & sht_idx
            End If
               
            Tbl_part_name = Tbl_name & "_" & sht_idx
           
            DelTable (Tbl_part_name)
           
            SQL_cmd = "SELECT * " & vbCrLf & _
                        "INTO [" & Tbl_part_name & "] " & vbCrLf & _
                        "FROM [" & Tbl_COPY_name & "]" & vbCrLf & _
                        "WHERE [record_idx] >= " & sht_idx * MaxRowPerSht + 1 & vbCrLf & _
                        "AND [record_idx] <= " & (sht_idx + 1) * MaxRowPerSht & vbCrLf & _
                        ";"
       
            'MsgBox SQL_cmd
            RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
            SQL_cmd = "ALTER TABLE [" & Tbl_part_name & "] " & vbCrLf & _
                        "DROP COLUMN [record_idx] " & vbCrLf & _
                        ";"
   
            RunSQL_CmdWithoutWarning (SQL_cmd)
           
           
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_part_name, Wb_path, True, Sht_part_name
           
            DelTable (Tbl_part_name)
           
        Next sht_idx
   
        DelTable (Tbl_COPY_name)
       
    End If

   
Exit_ExportTblToSht:
    ExportTblToSht = FailedReason
    Exit Function

Err_ExportTblToSht:
    FailedReason = Err.Description
    Resume Exit_ExportTblToSht
   
End Function

[Matlab] N X N Sudoku Solver

A few yrs ago, a mathematician created above sudoku, he claims it is the hardest sudoku at that time. For interest, I tried to create an algorithm to solve this stuff.

Due to my laziness, I had created the logic part a year ago, but just have finsihed the guessing part of the algorithm recently.

Below is my algorithim to solve N x N sudoku, where N = n^2, n is positive integer.
N is set as 9, the usaul size of most of sudoku.

In my current acknowledgement, the algorithm to solve a sudoku can be divided into two parts mainly --- Logical Deduction And Guessing.

Logical Deduction:
 As the title mentions, logically deduct the candidates of each unfilled blocks for one or many iterations, untill all the blocks are filled. Below is the algorithm

A. Omit Candidates of each unfilled blocks one by one.
a. list all the potential candidates(1-9) of each block

b. Check the row, column and the local 3x3 matrix of the blocks belonging, omit the impossible candidates

c. If only one candidates is left, fill the block.

d. If all the other blocks of the row, column, or the local 3x3 matrix are filled, then fill in the block with the right candidate.

e. if no cnadidate is left, then the solution is determined as wrong.

f. Redo above process untill the sudoku is finished or checked as wrong.


B. Omit Candidates in a local 3x3 matrix if the N blocks in a row or column of a local matrix have N candidates.
There are some cases that the algorithim part A cannot process further. The algorithim part B was created to handle these cases.

a. If there are N blocks in the same row or column of a local 3x3 matrix, all of them have N identical candidates.It implies the other two local rows and columns should not have these candidates. Then, omit these candidates from the other two local rows or columns.


Combing above two algorithm, this Logical Deduction algorithm can finish most of the sudoku.
---------------------------------------------------------------------------------------------------------------------------------

However, there are still some sudoku like the hardest one require guessing.
Below is the algorithm of the Generic Sudoku Solver.

2. Generic Sudoku Solver:
a. Solve the sudoku by Logical Deduction

b. If not finished or still correct, continue to step, c).

c. Count the possible candidates of each blocks

d. Select the block with the least candidates, then fill in one of the candidate, do the Generic Sudoku Solver with the new sudoku recursively.

e. if the returend sudoku is correct and complete, then stop the process.


By this algorithm, only three seconds and 114 times of guessing to solve this sudoku.
below is my answer

As Matrix is excellent for matrix operations, so Matlab was used to implement this algorithm.
Below is the code reference.
https://github.com/walter426/Matlab_SudokuSolver/

[Python] UART Command Tool with Dynamic PyGTK GUI

An example of dynamic gui built with PYGTK to do multi-therading for real-time update of the UART command handshaking.

https://github.com/walter426/Python_UartCmdTool/

[QGIS] QGIS Plugin - GeoSearch

A QGIS Plugin Tool for searching locations by address or position(latitude, longtitude).  Although 'GeoSearch' has similar function with 'GeoCode', but 'GeoSearch' has a easier GUI and zoom in feature.

Features:
Search location(with elevation) by words or point like google map; 
Calculate Distance between two points on mapCanvas.; 
Draw Route with multi ways points by google maps service.

https://github.com/walter426/QgisPlugin_GeoSearch/

[VBA] Link multiple Excel Sheets as Tables into Access Database

https://github.com/walter426/VbaUtilities/blob/master/ExcelUtilities.bas

Since the DoCmd.TransferSpreadsheet Method requires the range of the excel sheet to be linked, I wrote below function to find the used range of the sheet automatically, and do such linking of multiple sheets selected in the argument, "SheetNameList".
Besides, the local table name can also be user-defined in "SheetNameLocalList". If not, the default name in "SheetNameList" will be applied.
"ShtSeriesList" can be applied if there are multiple worksheets of the same type of name(e.g. "sample_1", "sample_2"), a generic pattern, "sample_*" can be used to indicated this kind of sheets for linking.
If the "HasFieldNames" is set as "True", the function will set the range stopped before the column of empty header to prevent from invalid header fault from Access

Code:

'Link multiple worksheets in workbooks
Public Function LinkToWorksheetInWorkbook(Wb_path As String, ByVal SheetNameList As Variant, Optional ByVal SheetNameLocalList As Variant, Optional ByVal ShtSeriesList As Variant, Optional HasFieldNames As Boolean = True) As String
    On Error GoTo Err_LinkToWorksheetInWorkbook

    Dim FailedReason As String

    If Len(Dir(Wb_path)) = 0 Then
        FailedReason = Wb_path
        GoTo Exit_LinkToWorksheetInWorkbook
    End If
    

    If VarType(SheetNameLocalList) <> vbArray + vbVariant Then
        SheetNameLocalList = SheetNameList
    End If
    

    'Prepare worksheets to be linked.
    If UBound(SheetNameList) <> UBound(SheetNameLocalList) Then
        FailedReason = "No. of elements in SheetNameList and SheetNameLocalList are not equal"
        GoTo Exit_LinkToWorksheetInWorkbook
    End If
    

    'Link worksheets
    Dim FullNameList() As Variant
    Dim SheetNameAndRangeList() As Variant

    Dim oExcel As Excel.Application
    Set oExcel = CreateObject("Excel.Application")
    
    With oExcel
        Dim oWb As Workbook
        Set oWb = .Workbooks.Open(Filename:=Wb_path, ReadOnly:=True)

        With oWb
            'Prepare to link worksheets in series
            If VarType(ShtSeriesList) = vbArray + vbVariant Then
            
                Dim ShtSeries As Variant
                
                Dim ShtSeries_name As String
                Dim ShtSeries_local_name As String
                Dim ShtSeries_start_idx As Integer
                Dim ShtSeries_end_idx As Integer
                
                Dim WsInS_idx As Integer
                Dim WsInS_cnt As Integer
                
                For Each ShtSeries In ShtSeriesList
                    ShtSeries_name = ShtSeries(0)
                    ShtSeries_local_name = ShtSeries(1)
                    ShtSeries_start_idx = ShtSeries(2)
                    ShtSeries_end_idx = ShtSeries(3)
                    
                    If ShtSeries_local_name = "" Then
                        ShtSeries_local_name = ShtSeries_name
                    End If
                    
                    
                    If ShtSeries_end_idx < ShtSeries_start_idx Then
                        ShtSeries_end_idx = .Worksheets.count - 1
                    End If
                    
                    
                    WsInS_cnt = 0
                
                    For WsInS_idx = ShtSeries_start_idx To ShtSeries_end_idx
                        If WorkSheetExist(oWb, Replace(ShtSeries_name, "*", WsInS_idx)) = True Then
                            WsInS_cnt = WsInS_cnt + 1
                        Else
                            Exit For
                        End If
                        
                    Next WsInS_idx
                
    
                    If WsInS_cnt > 0 Then
                        For WsInS_idx = 0 To WsInS_cnt
                            FailedReason = AppendArray(SheetNameList, Array(Replace(ShtSeries_name, "*", WsInS_idx)))
                            FailedReason = AppendArray(SheetNameLocalList, Array(Replace(ShtSeries_local_name, "*", WsInS_idx)))
                        Next WsInS_idx
                        
                    End If
                    
                Next ShtSeries
                
            End If
            
            'Link worksheets
            ReDim FullNameList(0 To UBound(SheetNameList))
            ReDim SheetNameAndRangeList(0 To UBound(SheetNameList))
    
            Dim SheetNameIdx As Integer
            Dim SheetName As String
            Dim FullName As String
            Dim ShtColCnt As Long
            Dim col_idx As Long
            Dim SheetNameAndRange As String

            For SheetNameIdx = 0 To UBound(SheetNameList)
                SheetName = SheetNameList(SheetNameIdx)
                DelTable (SheetNameLocalList(SheetNameIdx))
                  
                On Error Resume Next
                .Worksheets(SheetName).Activate
                On Error GoTo Next_SheetNameIdx_1
                
                With .ActiveSheet.UsedRange
                    ShtColCnt = .Columns.count
                    
                    If HasFieldNames = True Then
                        For col_idx = 1 To ShtColCnt
                            If IsEmpty(.Cells(1, col_idx)) = True Then
                                ShtColCnt = col_idx - 1
                                Exit For
                            End If
                        Next col_idx
                    End If
                    
                    SheetNameAndRange = SheetName & "!A1:" & ColumnLetter(oWb.ActiveSheet, ShtColCnt) & .Rows.count
                    
                End With '.ActiveSheet.UsedRange
                
                FullNameList(SheetNameIdx) = .FullName
                SheetNameAndRangeList(SheetNameIdx) = SheetNameAndRange
                
Next_SheetNameIdx_1:
            Next SheetNameIdx

            .Close False
            
        End With 'oWb
        
        .Quit
        
    End With 'oExcel
    

    For SheetNameIdx = 0 To UBound(SheetNameList)
        If SheetNameLocalList(SheetNameIdx) <> "" Then
            SheetName = SheetNameLocalList(SheetNameIdx)
        Else
            SheetName = SheetNameList(SheetNameIdx)
        End If
        
        FullName = FullNameList(SheetNameIdx)
        SheetNameAndRange = SheetNameAndRangeList(SheetNameIdx)

        DelTable(SheetName)
        
        On Error Resume Next
        DoCmd.TransferSpreadsheet acLink, , SheetName, FullName, True, SheetNameAndRange
        On Error GoTo Next_SheetNameIdx_2
        
Next_SheetNameIdx_2:
    Next SheetNameIdx
    
    On Error GoTo Err_LinkToWorksheetInWorkbook
    
    
Exit_LinkToWorksheetInWorkbook:
    LinkToWorksheetInWorkbook = FailedReason
    Exit Function

Err_LinkToWorksheetInWorkbook:
    FailedReason = Err.Description
    Resume Exit_LinkToWorksheetInWorkbook
    
End Function