Attribute VB_Name = "Module1"
 
Option Explicit                                                    ' ★☆△～√
 
    Public Const StrDir = "\Mdb"                                   ' 相對路徑
    Public Const Db_Name2 = "\Db_T.mdb"                            ' 數據庫
    Public Db_fN2 As String
    
    Public cnnTce As Connection, MyDb2 As Database, MyTb2 As TableDef
        
    Public MyRs0 As Recordset, strT0 As String, N0 As Integer      ' 記錄集、表名及記錄個數
    Public MyRs1 As Recordset, StrT1 As String, N1 As Integer
    Public MyRs2 As Recordset, StrT2 As String, N2 As Integer
    Public MyRs3 As Recordset, StrT3 As String, N3 As Integer
    Public MyRs4 As Recordset, StrT4 As String, N4 As Integer
    Public MyRs5 As Recordset, StrT5 As String, N5 As Integer
    
    Public strRq As String, StrCrq As String
    Public StrDms As String, StrUse As String, StrKls As String, StrUjb As String, BlnKlf As Boolean
    Public StrShm As String, StrGum As String, StrDwm As String
    Public StrSQL As String, StrMsg As String, StrTms As String, c As String, s As String
    Public StrPa1 As String, StrPa2 As String, StrPa3 As String
    Public i As Integer, j As Integer, k As Integer, zs As Integer
    Public l As Byte, m As Byte, n As Byte, u As Byte
    Public blnTc As Boolean

'   Declare Function flashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInsert As Long) As Long

    Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
            ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'
        
Sub Main()
    ' F_Start.Show       'frmSplash.Show       ' FormA5.Show   '
End Sub

Public Sub myP_mkDir(MyDir As String)                              ' 建立文件夾
 On Error Resume Next
    Call MkDir(MyDir)
End Sub

Function myF_ConnT(strDname As String) As Boolean                  ' ActivetX + Access
 On Error GoTo T_error
    Set cnnTce = New Connection                                    ' 建立一個連接  數據庫名 T
        cnnTce.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Persist Security Info=False;" & _
                    "Data Source=" & strDname
    myF_ConnT = True
    Exit Function
T_error:
    MsgBox "  " & strDname & " 連接失敗，無法導入數據 .... ", 48, "  很抱歉"
    myF_ConnT = False
    MsgBox "  " & "Error # " & Str$(Err.Number) & vbCrLf & vbCrLf & "  " & Err.Description
End Function

Function myF_ExistT(strTName As String) As Integer                 ' 判斷表 strTName 的存在
 On Error GoTo O_Err
    StrSQL = "Select * From " & strTName
    Set MyRs1 = New Recordset
    MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
    If MyRs1.EOF = True And MyRs1.BOF = True Then
       myF_ExistT = 0                                              ' 空表
    Else
       MyRs1.MoveLast
       myF_ExistT = MyRs1.RecordCount                              ' 返回記錄數
    End If
    MyRs1.Close: Set MyRs1 = Nothing
    Exit Function
O_Err:
    myF_ExistT = -1                                                ' 無表
End Function

Function myF_ChekTRec(strTName As String) As Integer               ' 檢查表記錄
    zs = myF_ExistT(strTName)
    If zs < 1 Then                                                 ' 無記錄
       Select Case strTName
              Case "T_rc"
                   StrMsg = "  應先處理比賽日程，請選 < A2.會期確定 >  ....  "
              Case "T_gm"
                   StrMsg = "  應先處理賽會分組，請選 < A3.競賽分組 >  ....  "
              Case "T_dw"
                   StrMsg = "  應先確定參賽單位，請選 < A4.單位安排 >  ....  "
              Case "T_pm"
                   StrMsg = "  應先處理比賽項目，請選 < A5.項目安排 >  ....  "
              Case "T_bm"
                   StrMsg = "  應先錄入比賽報名，請選 < A7.報名輸入 >  ....  "
              Case "T_md"
                   StrMsg = "  應先錄入比賽報名，請選 < A7.報名輸入 >  ....  "
              Case "T_shsj"
                   StrMsg = "  應先處理比賽時間排定，請選 < B4.比賽時間 >  ....  "
              Case "T_xlst"
                   StrMsg = "  應先進行資格賽順序抽簽排定，請選 < B7.分組抽簽 >  ....  "
              Case "V_Jscj"
                   StrMsg = "  應先進行資格賽順序抽簽排定，請選 < B7.分組抽簽 >  ....  "
              Case "V_Fjcj"
                   StrMsg = "  很抱歉，尚無同分決賽成績記錄  ....  "
       End Select
    End If
    myF_ChekTRec = zs
End Function

Function myP_cton(s As String) As Integer                          ' 漢字轉為數字（全能項數）
    Dim intSn As Integer
        If s Like "*一*" Then intSn = 1
        If s Like "*二*" Then intSn = 2
        If s Like "*三*" Then intSn = 3
        If s Like "*四*" Then intSn = 4
        If s Like "*五*" Then intSn = 5
        If s Like "*六*" Then intSn = 6
        If s Like "*七*" Then intSn = 7
        If s Like "*八*" Then intSn = 8
        If s Like "*九*" Then intSn = 9
        If s Like "*十*" Then intSn = 10
    myP_cton = intSn
End Function

Function myP_Ntoc(n As Integer) As String                          ' 數字轉為漢字（全能項數）
    Dim strSz As String
        If n = 1 Then strSz = "一"
        If n = 2 Then strSz = "二"
        If n = 3 Then strSz = "三"
        If n = 4 Then strSz = "四"
        If n = 5 Then strSz = "五"
        If n = 6 Then strSz = "六"
        If n = 7 Then strSz = "七"
        If n = 8 Then strSz = "八"
        If n = 9 Then strSz = "九"
        If n = 10 Then strSz = "十"
    myP_Ntoc = strSz
End Function

Function myF_ctod(ys As String) As Date                            ' 字符串 -> 日期類型
 On Error GoTo ProcError
    Dim i, m, n As String
        m = ""
    For i = 1 To Len(ys)
        n = Mid(ys, i, 1)
        m = m & IIf(n = "." Or n = ",", "-", n)                    ' 規(guī)范化例: "2002-02-02"
    Next
    myF_ctod = CDate(m)
ProcError:
    Exit Function
End Function

Function myF_ctos(ymd As String) As String                         ' 日期字符串規(guī)格化
    ymd = Trim(ymd)
 On Error GoTo ProcError
    Dim i, m, n As String
        m = ""
    For i = 1 To Len(ymd)
        n = Mid(ymd, i, 1)
        m = m & IIf(n = "." Or n = "," Or n = "/", "-", n)         ' 規(guī)范化例: "2002-02-02"
    Next
    myF_ctos = Format(CDate(m), "yyyy.mm.dd")                      ' 字符串規(guī)范化例: "2002.02.02"
ProcError:
    Exit Function
End Function

Function myF_Len(s As String) As Integer                           ' 返回字符串長度 ( 折合為英文字符位數 )
Dim i, l, n As Integer, m As String
    l = Len(s)
    n = 0
    If l > 0 Then
       For i = 1 To l
           m = Mid(s, i, 1)
           n = n + IIf(Asc(m) < 0, 2, 1)
       Next
    End If
    myF_Len = n
End Function

Function myF_Left(Zfc As String, Jqc As Byte) As String            ' 左起截取字符
Dim m As Byte, n As Byte, x As Byte
Dim c As String, s As String
    n = 0
    s = ""
    For x = 1 To Len(Zfc)
        c = Mid(Zfc, x, 1)
        m = IIf(Asc(c) < 0, 2, 1)
        If m + n > Jqc Then Exit For
        s = s & c
        n = n + m
    Next
    myF_Left = s
End Function

Function F_rqgs(c As String) As String                             ' 日期規(guī)格化
         If c = "" Then
            F_rqgs = " "
            Exit Function
         End If
         Dim m, s As String