VBA乱糟糟一筐

'FOR STRINGS--------------------------------------------------------------------------------------------------------------------
Sub getExtNameFromPath(ByVal pathStr$, ByRef ext$)
    Dim sep_pos%, fn$
    ext = ""
    Call getFileNameFromFullPath(pathStr, fn, "\")
    sep_pos = VBA.InStrRev(fn, ".")
    If sep_pos > 0 Then
        ext = VBA.Mid(fn, sep_pos + 1)
    End If
End Sub

Sub getKeyWordRightText(ByVal baseStr$, ByVal keyWord$, ByVal isKeyWordNeedOutput, ByRef rightText$)
    Dim i%
    rightText = ""
    i = VBA.InStr(1, baseStr, keyWord, vbTextCompare)
    If i > 0 Then
        If isKeyWordNeedOutput Then
            rightText = VBA.Mid(baseStr, i)
        Else
            rightText = VBA.Mid(baseStr, i + VBA.Len(keyWord))
        End If
    Else
        rightText = ""
    End If
End Sub

Sub getKeyWordLeftText(ByVal baseStr$, ByVal keyWord$, ByVal isKeyWordNeedOutput, ByRef leftText$)
    Dim i%
    leftText = ""
    i = VBA.InStr(1, baseStr, keyWord, vbTextCompare)
    If i > 1 Then
        If isKeyWordNeedOutput Then
            leftText = VBA.Mid(baseStr, 1, i - 1 + VBA.Len(keyWord))
        Else
            leftText = VBA.Mid(baseStr, 1, i - 1)
        End If
    Else
        leftText = ""
    End If
End Sub


Function fixFakeUtf8Space0xA0(ByVal s) As String
    Dim i&, cc%
    For i = VBA.LenB(s) To 1 Step -1
        cc = VBA.AscB(VBA.MidB(s, i, 1))
        If cc = &HA0 Then '160
            s = VBA.MidB(s, 1, i - 1) & VBA.ChrB(32) & VBA.MidB(s, i + 1)
        End If
    Next
    fixFakeUtf8Space0xA0 = s
End Function

Function fixFakeUtf8Space0xA0_v2(ByVal s) As String
    fixFakeUtf8Space0xA0_v2 = VBA.Replace(s, VBA.ChrB(160) & VBA.ChrB(0), " ")
End Function


'FOR REG--------------------------------------------------------------------------------------------------------------------
Sub getFirstMatchReg(ByVal str$, ByVal patternStr$, ByRef firstMatch$)
    Dim oRegExp As Object, oMatches As Object
    firstMatch = ""
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        .Global = True
        .Pattern = patternStr
        Set oMatches = .Execute(str)
        If oMatches.Count > 0 Then
            firstMatch = oMatches(0).submatches(0)
        End If
    End With
    Set oRegExp = Nothing: Set oMatches = Nothing
End Sub

'FOR ARRAY--------------------------------------------------------------------------------------------------------------------
Function isNoExistInStringArr(ByVal noStr$, ByRef noArr() As String, ByVal maxIdx%) As Boolean
    Dim i%
    isNoExistInStringArr = False
    For i = 0 To maxIdx - 1
        If noArr(i) = noStr Then
            isNoExistInStringArr = True
        End If
    Next
End Function

'FOR DEBUG--------------------------------------------------------------------------------------------------------------------
Sub debugOutputBinaryInfoByteByByte(ByVal s)
    Dim i&, cc%, str10$, str16$, ln&, sStr$
    str16 = "": str10 = "": sStr = ""
    ln = VBA.LenB(s)
    Debug.Print "string:" & s
    Debug.Print "length:" & ln & " bytes."
    For i = 1 To ln
        cc = VBA.AscB(VBA.MidB(s, i, 1))
        str10 = str10 & VBA.CStr(cc) & "   "
        str16 = str16 & "0x" & Hex(cc) & " "
        If (i Mod 2) = 1 Then
            'sStr = sStr & VBA.Mid(s, ((i - 1) / 2) + 1, 1) & "       "
        End If
    Next
    'Debug.Print sStr
    Debug.Print str16
    Debug.Print str10
End Sub

'FOR FILE SYSTEM--------------------------------------------------------------------------------------------------------------------
Sub getFileNameFromFullPath(ByVal longPath$, ByRef FileName$, ByVal seprator$)
    Dim i%
    FileName = ""
    i = VBA.InStrRev(longPath, seprator)
    If i > 0 Then
        FileName = VBA.Mid(longPath, i + 1)
        Exit Sub
    End If

    If longPath <> "" Then
        FileName = longPath
    End If
End Sub

Function getPath()
    Dim fnFullStr$
    fnFullStr = Application.GetOpenFilename(filefilter:="Excel03(*.xls),*.xls,Excel07(*.xlsx),*.xlsx,All File(*.*),*.*", title:="Get File Please.", MultiSelect:=False)
    If fnFullStr <> "False" Then
        getPath = fnFullStr
    End If
End Function

Sub changeDefaultWorkDir(ByRef fullDir$)
    If fullPath = "" Then
        ChDrive Mid(ThisWorkbook.path, 1, 1)
        ChDir ThisWorkbook.path
        Debug.Print "changeDefaultWorkDir:" & ThisWorkbook.path
    Else
        ChDrive Mid(fullDir, 1, 1)
        ChDir fullDir
        Debug.Print "changeDefaultWorkDir:" & fullDir
    End If
End Sub

Sub GetClipText(ByRef clipTxt$)
    Dim hMem As Long
    Dim lpData As Long
    Dim nClipSize As Long
    Dim bytClipData() As Byte
    Dim sClipString As String
    
    If OpenClipboard(ByVal 0&) Then
        hMem = GetClipboardData(CF_TEXT)
        If CBool(hMem) Then
            lpData = GlobalLock(hMem)
            nClipSize = GlobalSize(hMem)
            ReDim bytClipData(1 To nClipSize)
            CopyMemory bytClipData(1), ByVal lpData, nClipSize
            sClipString = StrConv(bytClipData, vbUnicode)
            clipTxt = sClipString
        Else
            MsgBox "No Text"
        End If
        CloseClipboard
    End If
End Sub

Sub pasteFromDiffColCopied()
    Dim s$, arr() As String, i%
    Call GetClipText(s)
    Debug.Print s
    Call debugOutputBinaryInfoByteByByte(s)
    arr = VBA.Split(s, VBA.Chr(13))
    Debug.Print UBound(arr)
    For i = 0 To UBound(arr)
        arr(i) = VBA.Trim(arr(i))
        Debug.Print arr(i)
    Next
End Sub

Function checkFileExis(ByVal checkPath$) As String
    On Error GoTo er1
    checkFileExis = "OK"
    If Not GetAttr(checkPath) And vbArchive Then 'maybe folder
        checkFileExis = "NG"
        Exit Function
    End If
    Exit Function
er1:
    'Debug.Print Err.Number & Err.Description
    checkFileExis = "NG"
    If Err.Number = 53 Then
        checkFileExis = "NG" 'file not found
    End If
    If Err.Number = 76 Then
        checkFileExis = "NG" 'path not found
    End If
End Function

Function checkDirExis(ByVal checkPath$) As String
    On Error GoTo er1
    checkDirExis = "OK"
    If Not GetAttr(checkPath) And vbDirectory Then 'maybe file
        checkDirExis = "NG"
        Exit Function
    End If
    Exit Function
er1:
    'Debug.Print Err.Number & Err.Description
    If Err.Number = 53 Then
        checkDirExis = "NG" 'file not found
    End If
End Function