-- 物件類別模組
# (模組) RegularExpression 正規化
> 使用內建函示庫 CreateObject("vbscript.regexp") 為基礎建立
## 搜尋符合字串，回傳第一筆結果
### [版次一] 2024/05/02
> (依序輸入： 原始字串； 正規化語法； 是否忽略大小寫，默認忽略)
#### 程式碼

Option Explicit

'搜尋符合的字串，回傳結果  
Public Function SelectValue(ByVal str_RawString As String, str_Condition As String, Optional bool_IgnoreCase As Boolean = True) As String
    Dim regEx As Object, matches As Object
    Dim str_return As String
    Set regEx = CreateObject("vbscript.regexp")

    '匹配文字
    regEx.Pattern = str_Condition
    '一次取代
    regEx.Global = True
    '不分大小寫
    regEx.IgnoreCase = bool_IgnoreCase
    '執行匹配
    Set matches = regEx.Execute(str_RawString)
    '返回匹配到的值
    If matches.Count > 0 Then
        str_return = matches(0)
    Else
        str_return = ""
    End If
    '釋放內存
    Set regEx = Nothing
    Set matches = Nothing
    '回傳
    SelectValue = str_return
End Function

### [版次二] 2025/05/15
> 新增進階提取子字串功能，默認不提取，可指定回傳第幾個
> (依序輸入： 原始字串； 正規化語法； 是否忽略大小寫，默認忽略； 提取子字串)
#### 程式碼

Option Explicit

'搜尋符合的字串，回傳結果  (依序輸入： 原始字串；正規化語法；忽略大小寫)
Public Function SelectValue(ByVal str_RawString As String, str_Condition As String, Optional bool_IgnoreCase As Boolean = True, Optional int_subMatch As Integer = -1) As String
    Dim regEx As Object, matches As Object
    Dim str_return As String
    Set regEx = CreateObject("vbscript.regexp")

    '匹配文字
    regEx.Pattern = str_Condition
    '一次取代
    regEx.Global = True
    '不分大小寫
    regEx.IgnoreCase = bool_IgnoreCase
    '執行匹配
    Set matches = regEx.Execute(str_RawString)
    '返回匹配到的值
    If matches.Count > 0 Then
        '2025/05/15 新增進階撈提取字串
        If int_subMatch < 0 Then
            str_return = matches(0)
        Else
            str_return = matches(0).SubMatches(0)
        End If
    Else
        str_return = ""
    End If
    '釋放內存
    Set regEx = Nothing
    Set matches = Nothing
    '回傳
    SelectValue = str_return
End Function

### 實際範例: 子字串
#### RegularExpression 資料比對
#### 對應 VBA 呼叫

str_ProcessTime = SelectValue(str_txtFileContext, "Date.Time\s*:\s*(\d{2}.\d{2}.\d{4}\s+\d{2}:\d{2}:\d{2})", True, 0)

 -----------------------------------------------------------------------------
  Lot Number     : 30UYGE
  Operator       : NA
  Magazine       : OK
  W/B-M/C        : 
  Customer Number: NA
  BD DWG NO.     : MT6991Z_TCZBHJD-P-H-D
  Date/Time      : 08/05/2025  02:07:51
  -----------------------------------------------------------------------------

## 取代符合字串為空值，回傳剩餘結果
### [版次一] 2024/05/02
> (依序輸入： 原始字串； 正規化語法； 是否忽略大小寫，默認忽略)
#### 程式碼

Option Explicit

'取代符合的字串為空字串，回傳剩下值
Public Function ReplaceValue(ByVal str_RawString As String, str_Condition As String, Optional bool_IgnoreCase As Boolean = True) As String
    Dim regEx As Object, matches As Object
    Dim str_return As String
    Set regEx = CreateObject("vbscript.regexp")

    '匹配文字
    regEx.Pattern = str_Condition
    '一次取代
    regEx.Global = True
    '不分大小寫
    regEx.IgnoreCase = bool_IgnoreCase
    '執行匹配
    str_return = regEx.Replace(str_RawString, "")
    '釋放內存
    Set regEx = Nothing
    Set matches = Nothing
    '回傳
    ReplaceValue = str_return
End Function

## 搜尋符合的字串，回傳所有結果
> (依序輸入： 原始字串； 正規化語法； 是否忽略大小寫，默認忽略)
#### 程式碼

Option Explicit

'SelectValue的變形，保留所有符合的字串，串再一起回傳
Public Function KeepValue(ByVal str_RawString As String, str_Condition As String, Optional bool_IgnoreCase As Boolean = True) As String
    Dim regEx As Object, matches As Object
    Dim str_return As String
    Dim int_i As Integer
    Set regEx = CreateObject("vbscript.regexp")
    str_return = ""
    
    '匹配文字
    regEx.Pattern = str_Condition
    '一次取代
    regEx.Global = True
    '不分大小寫
    regEx.IgnoreCase = bool_IgnoreCase
    '執行匹配
    Set matches = regEx.Execute(str_RawString)
    '返回匹配到的值
    For int_i = 0 To matches.Count - 1
        str_return = str_return & matches(int_i)
    Next
    '釋放內存
    Set regEx = Nothing
    Set matches = Nothing
    '回傳
    KeepValue = str_return
End Function

# (模組) Excel 環境設定
## 程式執行前，關閉 Excel Function
> 並非適用於所有情境，然多數時關閉如螢幕更新，會加快整體運算速度，降低程式出錯率
> 特別在Excel需大量處理幾十萬筆資料時，開啟可大幅降低Excel公式參照異常
#### 程式碼

Sub Close_Excel_fuction_for_efficiency()
    Application.ScreenUpdating = False      '(不)顯示螢幕更新
    Application.DisplayStatusBar = False    '(不)顯示狀態列
    Application.EnableEvents = False        '(不)物件觸發事件
    Application.DisplayAlerts = False       '(不)顯示對話視窗
    Application.AskToUpdateLinks = False    '(不)顯示更新
    Application.Calculation = xlCalculationManual   '(不)顯示Excel公式更新
End Sub

## 程式執行完，開啟 Excel Function
> 執行前若關閉對應項目，須確保程式結束重新打開功能，避免人工操作Excel畫面無回應
#### 程式碼

Sub Open_Excel_fuction_for_EndVBA()
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub

# (模組) 動態陣列
## 一維陣列

'動態一維陣列更新
Sub Reload_DynamicArray(ByRef strList_input() As String, ByVal str_input As String)
    
    Dim long_ListSize As Long
    
    '初始執行
    If strList_input(0) = "" Then
        
        strList_input(0) = str_input
        
        Exit Sub
    
    End If
        
    '非第一筆資料執行
    long_ListSize = UBound(strList_input)
    
    '擴充陣列
    ReDim Preserve strList_input(long_ListSize + 1)
    
    '將輸入值帶入最後
    strList_input(long_ListSize + 1) = str_input
    
End Sub

## 二維/多維陣列

'動態二/多維陣列更新
Sub Reload_DynamicArray2(strArray_input() As String, strList_input() As String)
    
    Dim long_ArraySize As Long
        
    '初始執行
    If strArray_input(0) = "" Then
        
        strArray_input(0) = strList_input
        
        Exit Sub
    
    End If
        
    '非第一筆資料執行
    long_ArraySize = UBound(strArray_input)
    
    '擴充陣列
    ReDim Preserve strArray_input(long_ArraySize + 1)
    
    '將輸入值帶入最後
    strArray_input(long_ArraySize + 1) = strList_input()
    
End Sub

# Graphical User Interface 圖形化介面
## 資料夾選取

Option Explicit

'Create Global Variables
Public workbook_Marco As Workbook
Public worksheet_Tool As Worksheet

Public range_SourceFolderPath As Range
Public range_DestinationFolderPath As Range

Public str_SourceFolderPath As String
Public str_DestinationFolderPath As String
Public str_FileNameExtension As String
Public int_DeleteTxtLine As Integer


'初值建立
Sub Set_Global_Variables()
    
    Set workbook_Marco = Workbooks("WaferMapping小工具ver1.0_(Security C).xlsm")
    Set worksheet_Tool = workbook_Marco.Worksheets("參數設定與檔案執行")
    
    With worksheet_Tool
            
        .Activate
        
        Set range_SourceFolderPath = .Range("D3")
        Set range_DestinationFolderPath = .Range("D4")
        
        str_SourceFolderPath = range_SourceFolderPath
        str_DestinationFolderPath = range_DestinationFolderPath
'        float_CmdDelaySecond = CDbl(.Range("D7"))   '單位秒，執行每筆CMD需Delay時間。 根據執行電腦端進行調整
        str_FileNameExtension = UCase(.Range("D7"))   '防呆，英文強制轉大寫 -> 按MTK去寫程式
        int_DeleteTxtLine = CInt(.Range("D8"))
    
    End With
    
End Sub


Sub Button_SourceFolderSelect()
    Call Close_Excel_fuction_for_efficiency
    
    Call Set_Global_Variables
    
    Call FillSheetData_FromSelecFolder(range_SourceFolderPath)
    
    Call Open_Excel_fuction_for_EndVBA
End Sub
Sub Button_DestinationFolderSelect()
    Call Close_Excel_fuction_for_efficiency
    
    Call Set_Global_Variables
    
    Call FillSheetData_FromSelecFolder(range_DestinationFolderPath)
    
    Call Open_Excel_fuction_for_EndVBA
End Sub


Private Function SelectFolder() As String
    On Error GoTo ExceptionHandle
    
    Dim bool_RunAction As Boolean
    bool_RunAction = True

    Dim object_FolderSelect As FileDialog
    Dim str_FolderPath As String
    
    Set object_FolderSelect = Application.FileDialog(msoFileDialogFolderPicker)
    
    '選擇資料夾，則返回 -1，反之回傳 0
    str_FolderPath = IIF(object_FolderSelect.Show = -1, object_FolderSelect.SelectedItems(1), "")

    Set object_FolderSelect = Nothing
    
    bool_RunAction = False

ExceptionHandle:
    If bool_RunAction = True Then str_FolderPath = ""
    
    SelectFolder = str_FolderPath
    
End Function
Private Sub FillSheetData_FromSelecFolder(inputRange As Range)
    
    Dim var_temp As Variant
    Dim str_Data As String
    
    str_Data = SelectFolder()
    
    If str_Data = "" Then
        
        var_temp = MsgBox("未成功選取資料夾！ 請重新進行選取！！", vbExclamation, "選取異常")
                    
        Exit Sub
        
    End If
    
    inputRange = str_Data
    
End Sub

# 建立新資料夾/檔案
## 說明
> 因為VBA呼叫CMD，會涉及到非同步議題 (CMD還沒複製完檔案，就開始執行下筆VBA)
所以這邊可以改成使用VBA 內建功能 CreateObject("Scripting.FileSystemObject")
## 程式

'同步複製檔案
Private Sub CopyFile(ByVal strFilePath_Source As String, ByVal strFolderPath_Destination As String)
    
    Dim object_FSO As Object
    Dim var_temp As Variant
    Dim strFilePath_Destination As String
    
    Set object_FSO = CreateObject("Scripting.FileSystemObject")
    
    strFilePath_Destination = strFolderPath_Destination _
                        & Right(strFilePath_Source, Len(strFilePath_Source) - InStrRev(strFilePath_Source, "\"))
    
    '<防呆> 若原本檔案存在，先刪除
    If object_FSO.FileExists(strFilePath_Destination) Then object_FSO.DeleteFile strFilePath_Destination, True
    
    '複製檔案
    If object_FSO.FolderExists(strFolderPath_Destination) Then
        object_FSO.CopyFile strFilePath_Source, strFilePath_Destination, True
    Else
       '<防呆>
'       var_temp = MsgBox("發生異常！ " & strFilePath_Destination & " 檔案未建立成功！！", vbExclamation, "執行異常")
        Err.Raise vbObjectError + 5487, "CopyFile", "未發現檔案路徑" & vbCrLf & strFolderPath_Destination
    End If
    
    Set object_FSO = Nothing
    
End Sub

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'比較帶入檔案位置，另存新檔案至對應位置
'PS:原本CMD其實可執行，但GPT4建議因CMD為非同步作業，會增加VBA等待不穩定性 (一筆0.5sec，太久)。 故改成VBA內建處理資料夾新增/檔案複製，會比較優選

Private Function SaveCopyNewFile_AndGetPath(ByVal strInput_FilePath As String) As String
    
    Dim object_FSO As Object
    Dim var_temp As Variant
    Dim str_NewFilePath As String, str_NewFolderPath As String
    
    Set object_FSO = CreateObject("Scripting.FileSystemObject")
    
    str_NewFilePath = str_DestinationFolderPath & Replace(strInput_FilePath, str_SourceFolderPath, "")
    str_NewFolderPath = Left(str_NewFilePath, InStrRev(str_NewFilePath, "\") - 1)
    
'    '<測試>
'    Debug.Print "cmd.exe /c mkdir """ & str_NewFolderPath & """ && copy /Y """ & strInput_FilePath & """ """ & str_NewFilePath & """"
    
    '檢查資料夾是否存在，否則建立
    If Not object_FSO.FolderExists(str_NewFolderPath) Then Call CreateFolder(object_FSO, str_NewFolderPath)
    
'    Shell ("cmd.exe /c mkdir """ & str_NewFolderPath & """")
'
'    If float_CmdDelaySecond > 0 Then Sleep float_CmdDelaySecond * 1000
    
    '複製檔案
    If object_FSO.FolderExists(str_NewFolderPath) Then
        object_FSO.CopyFile strInput_FilePath, str_NewFilePath, True
    Else
       '<防呆>
       var_temp = MsgBox("發生異常！ " & str_NewFilePath & " 檔案未建立成功！！", vbExclamation, "執行異常")
    End If
    
'    Shell ("cmd.exe /c copy /Y """ & strInput_FilePath & """ """ & str_NewFilePath & """")
'
'    If float_CmdDelaySecond > 0 Then Sleep float_CmdDelaySecond * 1000
    
    Set object_FSO = Nothing
    
    SaveCopyNewFile_AndGetPath = str_NewFilePath
    
End Function
Private Sub CreateFolder(ByRef object_FSO As Object, ByVal str_NewFolderPath As String, Optional ByVal str_OriginFolderPath As String = "")
    
    Dim strArray_SplitFolderPath() As String
    Dim str_tempFolderPath As String
    Dim int_i As Integer
    
    If str_OriginFolderPath = "" Then str_OriginFolderPath = range_DestinationFolderPath
    
    str_tempFolderPath = str_OriginFolderPath & "\"
    
    strArray_SplitFolderPath = Split(Replace(str_NewFolderPath, str_tempFolderPath, ""), "\")

    For int_i = LBound(strArray_SplitFolderPath) To UBound(strArray_SplitFolderPath)
        str_tempFolderPath = str_tempFolderPath & strArray_SplitFolderPath(int_i) & "\"
        If Not object_FSO.FolderExists(str_tempFolderPath) Then
            object_FSO.CreateFolder str_tempFolderPath
        End If
    Next
    
End Sub

# 檔案讀寫
## 說明
> 使用 VBA 內建功能 CreateObject("ADODB.Stream")，以txt開啟檔案進行編寫
## 程式

'處理帶入的.MTK檔 (Wafer) ，留著Raw分頁待後續作業 (尚未點選OS圖片生成)
Private Sub RunData_ByWaferFile(ByVal str_MtkFilePath As String)

'    '<測試> 尋找是否正確找到所有.MTK檔
'    Debug.Print str_MtkFilePath
    
    Dim object_ADO As Object
    Dim str_NewFilePath As String, str_txtFileContext As String
    
    '讀檔
    Set object_ADO = CreateObject("ADODB.Stream")
    
    With object_ADO
        .Charset = "utf-8"
        .Open
        .LoadFromFile (str_MtkFilePath)
        str_txtFileContext = .ReadText()
        .Close
    End With
    
    '根據現有格式偵測處理，未符合條件檔案
    If Split(str_txtFileContext, vbCrLf)(0) = str_FileNameExtension _
    And Right(Split(str_txtFileContext, vbCrLf)(3), 3) = str_FileNameExtension Then
        
        '同步另存新檔案
        str_NewFilePath = SaveCopyNewFile_AndGetPath(str_MtkFilePath)
        
        '<方案1> 基本有四行，第一行、第四行結尾為副檔名
        Call OverWriteTxt(object_ADO, str_txtFileContext, str_NewFilePath)
    
    Else
        
        '<方案3> 每份都包含一個Mapping跟Bin的資訊
        If Split(str_txtFileContext, vbCrLf)(0) = "Customer:" & str_FileNameExtension _
        And Left(Split(str_txtFileContext, vbCrLf)(1), 8) = "Schedule" Then
            
            '同步另存新檔案
            str_NewFilePath = SaveCopyNewFile_AndGetPath(str_MtkFilePath)
            
        '<方案2> 以上的其他狀況，嘉緯說就不複製了
        Else
            
        End If
        
    End If
    
    Set object_ADO = Nothing

End Sub
'以TXT方式，覆蓋編寫檔案 (From RunData_ByWaferFile)
Private Sub OverWriteTxt(ByRef object_ADO As Object, ByVal str_TxtContent As String, ByVal str_NewFilePath As String)
    
    Dim str_TxtLines() As String
    Dim str_newConText As String
    Dim int_i As Integer
    
    ' 處理內容
    str_newConText = ""
    
    str_TxtLines = Split(str_TxtContent, vbCrLf)
    
    For int_i = int_DeleteTxtLine To UBound(str_TxtLines)
        str_newConText = str_newConText & str_TxtLines(int_i) & vbCrLf
    Next
    
    If Right(str_newConText, 2) = vbCrLf Then str_newConText = Left(str_newConText, Len(str_newConText) - 2)

    ' 覆寫檔案
    With object_ADO
        .Charset = "utf-8"
        .Type = 2
        .Open
        .WriteText str_newConText
        .SaveToFile str_NewFilePath, 2
        .Close
    End With
    
End Sub

# 多層資料夾搜尋
## 說明
> 因為VBA使用Dir()，僅能搜尋單層資料夾
故使用 VBA 內建功能 CreateObject("Scripting.FileSystemObject")，搭配進行遞迴搜尋
## 程式

'取得工作頁來源資料夾，帶入遞迴遍尋 (Call Search_SubFolder)
Private Sub Search_rootFolder(str_SourcePath As String)

    Dim object_FileSystem As Object, object_rootFolder As Object
    
    Set object_FileSystem = CreateObject("Scripting.FileSystemObject")

    '匯入工作頁來源資料夾
    Set object_rootFolder = object_FileSystem.GetFolder(str_SourcePath)

    '遍尋來源資料夾底下，所有.MTK檔
    Call Search_SubFolder(object_rootFolder)

    Set object_rootFolder = Nothing
    Set object_FileSystem = Nothing

End Sub
'遞迴，遍尋每個資料夾，將符合.MTK檔帶入搜尋 (Call Search_MtkFile)
Private Sub Search_SubFolder(object_nodeFolder As Object)

    Dim object_subFolder As Object

    For Each object_subFolder In object_nodeFolder.subfolders

        '如果子資料夾底下還有資料夾，繼續遞迴遍尋
        If object_subFolder.subfolders.Count > 0 Then
            
            Call Search_SubFolder(object_subFolder)
        
        '反之，將該子資料夾，拋去偵測
        Else
            
            Call Search_MtkFile(object_subFolder)
        
        End If

    Next object_subFolder
    
    '另外自己當下這層資料夾，也可能存在相應檔案，也須帶入偵測處理
    Call Search_MtkFile(object_nodeFolder)

End Sub
'搜尋資料夾底下的.MTK檔，將檔案帶入正規化處理 (Call RunData_ByWaferFile)
Private Sub Search_MtkFile(object_nodeFolder As Object)

    Dim var_temp As Variant
    Dim strList_MtkFilePath() As String
    Dim str_nodeFolder As String, str_temp As String, str_FileNameExtension_ForReg As String

    ReDim strList_MtkFilePath(0)
    str_nodeFolder = object_nodeFolder.Path & "\"
    str_FileNameExtension_ForReg = "." & UCase(str_FileNameExtension) & "|." & LCase(str_FileNameExtension)     ' ".MTK|.mtk"

    '遍尋是否存在.MTK檔，符合檔案拋到一維陣列儲存 (strList_MtkFilePath)
    str_temp = Dir(str_nodeFolder)

    Do While str_temp <> ""

        If RegularExpression.SelectValue(str_temp, str_FileNameExtension_ForReg) <> "" Then Call Reload_DynamicArray(strList_MtkFilePath, str_nodeFolder & str_temp)

        str_temp = Dir()

    Loop

    '如果找到.MTK檔，就抓去處理 (Call RunData_ByWaferFile)
    For Each var_temp In strList_MtkFilePath

        If var_temp <> "" Then Call RunData_ByWaferFile(var_temp)

    Next

End Sub

# Notes 寄信
## Main

Private Sub function_Note()
    Dim Note As New class_Note
    Note.Setting_To = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
    Note.Setting_CC = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
'    Note.Setting_BCC = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
    Note.Setting_Subject = "測試 Test"
'    Note.Setting_SecurityLevel = "C"
    Note.Setting
'    Note.Show_NoteSet
    Note.Add_Entity "Content", "</h2><p><font face=""微軟正黑體"", size=""3"">Image</font></p><img src=""cid:TestImage.jpg"" alt=""<圖片遺失！！>""><p>this is Test from VBA Send Notes</p><p><br>Thanks.</p><br>"
    Note.Add_Entity "Image", "", "D:\ASEKH\K17805\VBA\(Test)自主練習\DownloadData\TestImage.jpg"
    Note.Add_Entity "File", "", "D:\ASEKH\K17805\VBA\(Test)自主練習\DownloadData\Rowdata_(Security C).xlsx"
    Note.Run
    Note.Clear
End Sub

## clase_Note

'<備註>
'   1. 範例：
    '    Dim Note As New class_Note
    '    Note.Setting_To = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
    '    Note.Setting_CC = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
    ''    Note.Setting_BCC = Array("WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE", "WeiCheng Lee/ASEK/ASE@ASE")
    '    Note.Setting_Subject = "測試 Test"
    ''    Note.Setting_SecurityLevel = "C"
    '    Note.Setting
    ''    Note.Show_NoteSet
    '    Note.Add_Entity "Content", "</h2><p><font face=""微軟正黑體"", size=""3"">Image</font></p><img src=""cid:TestImage.jpg"" alt=""<圖片遺失！！>""><p>this is Test from VBA Send Notes</p><p><br>Thanks.</p><br>"
    '    Note.Add_Entity "Image", "", "D:\ASEKH\K17805\VBA\(Test)自主練習\DownloadData\TestImage.jpg"
    '    Note.Add_Entity "File", "", "D:\ASEKH\K17805\VBA\(Test)自主練習\DownloadData\Rowdata_(Security C).xlsx"
    '    Note.Run
    '    Note.Clear
'
'   2. 需搭配 class_Note2 類別模組使用
'
'   3. 三種用法：(1) "Content" -> 輸入Html語法 (指定Image資訊)
'                (2) "Image"   -> 給檔案名稱即可
'                (3) "File"    -> 給檔案名稱即可，若跳出後綴名需擴充，再額外寫 (目前僅實裝常用檔案格式)


Option Explicit

Dim array_To As Variant, array_CC As Variant, array_BCC As Variant
Dim str_Subject As String, str_SecurityLevel As String

Dim object_Notes As Object, object_Stream As Object, object_document As Object, object_NotesSession As Object
Dim object_MimeEntity As Object, object_Prefix As Object, object_Suffix As Object, object_Entity As Object

Dim class_listFile As New class_Note2  '檔案格式對應MIME表


'輸入/更改參值 (檔案來源, SQL指令)
Public Property Let Setting_To(inputArray_To As Variant)
    array_To = inputArray_To
End Property
Public Property Let Setting_CC(inputArray_CC As Variant)
    array_CC = inputArray_CC
End Property
Public Property Let Setting_BCC(inputArray_BCC As Variant)
    array_BCC = inputArray_BCC
End Property
Public Property Let Setting_Subject(inputStr_Subject As String)
    str_Subject = inputStr_Subject
End Property
Public Property Let Setting_SecurityLevel(inputStr_SecurityLevel As String)
    str_SecurityLevel = inputStr_SecurityLevel
End Property


Public Sub Setting()
    '先設定格式對應表
'    class_listFile.Setting_suffix = Array(".csv", ".doc", ".docx", ".htm", ".html", ".jpeg", ".jpg", ".js", ".json", ".jsonld", ".png", ".ppt", ".pptx", ".rar", ".svg", ".txt", ".xls", ".xlsx", ".zip", ".7z")
    class_listFile.Setting_suffix = Array("csv", "doc", "docx", "htm", "html", "jpeg", "jpg", "js", "json", "jsonld", "png", "ppt", "pptx", "rar", "svg", "txt", "xls", "xlsx", "zip", "7z")
    class_listFile.Setting_MIME = Array("text/csv", "application/msword", "application/vnd.openxmlformats-officedocument.wordprocessingml.document", "text/html", "text/html", "image/jpeg", "image/jpeg", "text/javascript", "application/json", "application/ld+json", "image/png", "application/vnd.ms-powerpoint", "application/vnd.openxmlformats-officedocument.presentationml.presentation", "application/vnd.rar", "image/svg+xml", "text/plain", "application/vnd.ms-excel", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet", "application/zip", "application/x-7z-compressed")
    
    
    Set object_Notes = CreateObject("Notes.NotesSession")
    '指定資料庫
    Set object_Stream = object_Notes.CREATESTREAM
    '新增文件
    Set object_document = object_Notes.CURRENTDATABASE.createDocument
    '不將內文轉成 RichText形式
    object_Notes.CONVERTMIME = False
    
    Set object_NotesSession = CreateObject("Notes.NotesSession")
    
    With object_document
        '收件人(to)
        If IsEmpty(array_To) Then
            array_To = Array("")
            MsgBox "請先填入收件人！！"
            Exit Sub
        End If
        .SendTo = array_To
        
        '收件人(CC)
        If IsEmpty(array_CC) Then
            array_CC = Array("")
        End If
        .CopyTo = array_CC
        
        '收件人(BCC)
        If IsEmpty(array_BCC) Then
            array_BCC = Array("")
        End If
        .BlindCopyTo = array_BCC
        
        '信件標題
        If str_Subject = "" Then
            MsgBox "請先填入信件標題！！"
            Exit Sub
        End If
        .Subject = str_Subject
        
        '機密等級(Security A/B/C/D)
        If str_SecurityLevel = "" Then
            str_SecurityLevel = "C"
        End If
        .SecurityLevel = str_SecurityLevel
        
        '格式指定
        .form = "Memo"
    End With
    
    Set object_MimeEntity = object_document.CREATEMIMEENTITY
        
    'ASE Notes前綴
    Set object_Prefix = object_MimeEntity.CREATECHILDENTITY
    With object_Prefix
        object_Stream.WRITETEXT _
        "<html><head><p><font size=""3"">** Security C ** <br></p><br></head>"
        .SETCONTENTFROMTEXT object_Stream, "text/HTML;charset=UTF-8", 1725
        object_Stream.Close
        object_Stream.TRUNCATE
    End With
End Sub


Public Sub Show_NoteSet()
    MsgBox "To : " & Join(array_To, ",  ") & vbCrLf & vbCrLf _
            & "CC : " & Join(array_CC, ",  ") & vbCrLf & vbCrLf _
            & "BCC : " & Join(array_BCC, ",  ") & vbCrLf & vbCrLf _
            & "Subject : " & str_Subject & vbCrLf _
            & "SecurityLevel : " & str_SecurityLevel _
            , vbInformation, "寄信資訊設定清單"
'    MsgBox "To : " & Join(array_To, vbCrLf & "        ") & vbCrLf & vbCrLf _
'            & "CC : " & Join(array_CC, vbCrLf & "        ") & vbCrLf & vbCrLf _
'            & "BCC : " & Join(array_BCC, vbCrLf & "          ") & vbCrLf & vbCrLf _
'            & "Subject : " & str_Subject & vbCrLf _
'            & "SecurityLevel : " & str_SecurityLevel _
'            , vbInformation, "寄信資訊設定清單"
End Sub


Public Sub Add_Entity(str_EntityType As String, Optional str_content As String = "", Optional str_Source As String = "")      'str_EntityType，像bool的選項輸入可能?
    Dim str_fileName As String, str_MIME As String
    
    Set object_Entity = object_MimeEntity.CREATECHILDENTITY
    With object_Entity
        Select Case str_EntityType
            Case "Content"
                object_Stream.WRITETEXT _
                "<body>" & str_content & "</body>"
                .SETCONTENTFROMTEXT object_Stream, "text/HTML;charset=UTF-8", 1725
                object_Stream.Close
                object_Stream.TRUNCATE
                
            Case "Image"
                '<防呆>偵錯，未輸入變數則提醒 (終止程式運行)
                If str_Source = "" Then
                    MsgBox "！！請確認Add_Entity呼叫變數是否有誤！！"
                    End
                End If
                
                str_fileName = Mid(str_Source, InStrRev(str_Source, "\") + 1)
                .CREATEHEADER("Content-ID").SETHEADERVAL str_fileName
                object_Stream.Open str_Source, "binary"
                .SETCONTENTFROMBYTES object_Stream, "image/jpeg;name=" & str_fileName, 1730
                object_Stream.Close
                object_Stream.TRUNCATE
                
            Case "File"
                '<防呆>偵錯，未輸入變數則提醒 (終止程式運行)
                If str_Source = "" Then
                    MsgBox "！！請確認 Add_Entity 呼叫變數是否有誤！！"
                    End
                End If
                
                str_fileName = Mid(str_Source, InStrRev(str_Source, "\") + 1)
'                str_MIME = class_listFile.Getting_MIME_Value("B")
                If InStr(str_fileName, ".") > 0 Then
                    str_MIME = class_listFile.Getting_MIME_Value(Mid(str_Source, InStrRev(str_Source, ".") + 1))
                Else    '<防呆>偵錯，使用者檔案輸入錯誤 (終止程式運行)
                    MsgBox "！！請確認輸入 str_fileName 檔案名稱是否有誤！！"
                    End
                End If
                
                '<防呆>需再擴充檔案格式(後綴名) (終止程式運行)
                If str_MIME = "" Then
                    MsgBox "！！請聯絡開發人員，擴充檔案格式 " & Mid(str_Source, InStrRev(str_Source, ".") + 1) & "！！"
                    End
                End If
                    
'                Dim int_i As Integer
'                For int_i = 0 To class_listFile.Getting_suffix_ArrayNumber
'                    If LCase(Split(str_fileName, ".")(-1)) = class_listFile.Getting_suffix_Value(   Setting_suffix(int_i) Then
'                        str_MIME = Setting_MIME(int_i)
'                        Exit For
'                    End If
'                Next

                .CREATEHEADER("Content-ID").SETHEADERVAL str_fileName
                object_Stream.Open str_Source, "binary"
                .SETCONTENTFROMBYTES object_Stream, str_MIME & ";name=" & str_fileName, 1730
                object_Stream.Close
                object_Stream.TRUNCATE
                
            Case Else
                Set object_Entity = Nothing
                Exit Sub
        End Select
    End With
    Set object_Entity = Nothing
End Sub


Public Sub Run()
    'ASE Notes後綴
    Set object_Suffix = object_MimeEntity.CREATECHILDENTITY
    With object_Suffix
        object_Stream.WRITETEXT _
        "<foot><p><font face=""Default Monospace"", size=""2""><br><br>----- ASE Confidentiality Notice -----<br>The preceding message (including any attachments) contains proprietary information that may be confidential, privileged, or constitute non-public information. It is to be read and used solely by the intended recipient(s) or <br>conveyed only to the designated recipient(s). If you are not an intended recipient of this message, please notify the author or sender immediately either by replying to this message or by telephone at 886-7-3617131 and delete <br>this message (including any attachments hereto) immediately from your system. You should not read ,retain, disseminate, distribute, copy or use this message in whole or in part for any purpose, not disclose all or any part of <br>its content to any other person.<br>----- ASE Confidentiality Notice -----</p></foot></html>"
        .SETCONTENTFROMTEXT object_Stream, "text/HTML;charset=UTF-8", 1725
        object_Stream.Close
        object_Stream.TRUNCATE
    End With

    '存取郵件
    object_document.SAVEMESSAGEONSEND = True
    '忽略錯誤
    On Error Resume Next
    '寄出Mail
    object_document.send False
End Sub


'結束時釋放記憶體
Public Sub Clear()
    Set object_Notes = Nothing
    Set object_Stream = Nothing
    Set object_document = Nothing
    Set object_NotesSession = Nothing
    Set object_MimeEntity = Nothing
    Set object_Prefix = Nothing
    Set object_Suffix = Nothing
    Set object_Entity = Nothing
End Sub




'更新紀錄
'初版：2024/05/02    By  WeiCheng_Lee

## class_Note2

'<備註>
'   搭配 class_Note 使用


Option Explicit

Dim str_suffix As Variant, str_MIME As Variant


'輸入/更改參值 (檔案來源, SQL指令) <註1>
Public Property Let Setting_suffix(input_suffix As Variant)
    str_suffix = input_suffix
End Property
Public Property Let Setting_MIME(input_MIME As Variant)
    str_MIME = input_MIME
End Property


''取得陣列大小 (目前有多少值)
'Public Function Getting_suffix_ArrayNumber() As Integer
'    Getting_ArrayNumber = UBound(str_suffix)
'End Function
'
''輸入數字(陣列第幾個值)，取得對應Array值
'Public Function Getting_suffix_Value(int_input As Integer) As String
'    Getting_suffix_Value = str_suffix(int_input)
'End Function
'Public Function Getting_MIME_Value(int_input As Integer) As String
'    Getting_MIME_Value = str_MIME(int_input)
'End Function

'輸入suffix對應值，參照MIME Array對應值
Public Function Getting_MIME_Value(inputStr_suffix As String) As String
    Dim int_i As Integer
    For int_i = 0 To UBound(str_suffix)
        If str_suffix(int_i) = inputStr_suffix Then
            Getting_MIME_Value = str_MIME(int_i)
            Exit Function
        End If
    Next
    '若找不到，回傳空值
    Getting_MIME_Value = ""
End Function




'更新紀錄
'初版：2024/05/02    By  WeiCheng_Lee

## Other 類型研究

Option Explicit

Dim source_workbook As Workbook
Dim source_worksheet As Worksheet


Sub Main_Notes()
    '(無關)資料來源
    Set source_workbook = Workbooks.Open(ThisWorkbook.Path & "\DownloadData\Rowdata_(Security C).csv")
    Set source_worksheet = source_workbook.Sheets("Rowdata_(Security C)")
    
    
    '1. 文字 + 附圖 ，會卡UI控制
'    Call WorkspaceUI
    '2. 文字 + 附檔(圖片or文件檔都可) ，可繞過UI卡控   <- 這個好像沒有公司信件的格式，不知道為啥
'    Call RichText
    '3. 利用MIME傳送，功能齊全但較為複雜，可繞過UI卡控
    Call Html
    
    source_workbook.Close
End Sub


Private Sub WorkspaceUI()
    Dim object_Notes As Object
    Set object_Notes = CreateObject("Notes.NotesUIWorkspace")
    '寄件人
    Dim object_document As Object
    Set object_document = object_Notes.COMPOSEDOCUMENT("TWKHM13/ASE", "mail7\WeiCheng_Lee.nsf", "Memo")
    '收件人(To)
    Call object_document.FIELDSETTEXT("EnterSendTo", "WeiCheng Lee/ASEK/ASE@ASE")
    '收件人(CC)
    Call object_document.FIELDSETTEXT("EnterCopyTo", "WeiCheng Lee/ASEK/ASE@ASE")
    '信件標題
    Call object_document.FIELDSETTEXT("Subject", "VBA Test (Security C)")
    '機密等級(Security A/B/C/D)
    Call object_document.FIELDSETTEXT("SecurityLevel", "C")
    
    '內文
    Call object_document.GOTOFIELD("Body")
    '輸入文字
    Call object_document.InsertText(vbCrLf & vbCrLf & vbCrLf & "<WorkspaceUI>" & vbCrLf & vbCrLf & vbCrLf & vbCrLf)
    '附圖
        '1. 貼圖
        '(無關)這邊先去Excel撈圖
        With source_worksheet
            .Activate
            '1.從Excel抓取Cells範圍當圖片
            range(.Cells(1, 1), .Cells(5, 16)).Copy
            Application.Wait (DateAdd("s", 1, Now))
        End With
        '把圖貼上
        Call object_document.Paste
        
        '2. 匯入已存好得圖
'       Call object_document.import("JPEG Image", 圖像路徑)

    '寄出Mail
    Call object_document.send
    '關閉Mail視窗
    Call object_document.Close(-1)
End Sub


Private Sub RichText()
    Dim object_Notes As Object
    Set object_Notes = CreateObject("Notes.NotesSession")
    '指定資料庫
    Dim object_Database As Object
    Set object_Database = object_Notes.CURRENTDATABASE
    '新增文件
    Dim object_document As Object
    Set object_document = object_Database.createDocument
    
    With object_document
        '收件人(to)
        .SendTo = Array("WeiCheng Lee/ASEK/ASE@ASE")
        '收件人(CC)
        .CopyTo = Array("WeiCheng Lee/ASEK/ASE@ASE")
        '信件標題
        .Subject = "VBA Test (Security C)"
        '機密等級(Security A/B/C/D)
        .SecurityLevel = "C"    '不知道有沒有效
        '格式指定
        .form = "Memo"
        '寄件備份
        .SAVEMESSAGEONSEND = True
    End With
    
    '設定內文
    '物件
    Dim object_contextItem As Object
    Set object_contextItem = object_document.CREATERICHTEXTITEM("Body")
    '文字
    Call object_contextItem.APPENDTEXT("RichText")
    '換行
    Call object_contextItem.ADDNEWLINE(2)
    '附件
    Call object_contextItem.EMBEDOBJECT(1454, "", source_workbook.Path & "\Rowdata_(Security C).csv")
        '參考：https://help.hcltechsw.com/dom_designer/9.0.1/appdev/H_EMBEDOBJECT_METHOD.html
    
    '寄出Mail
    Call object_document.send(False)
End Sub


Private Sub Html()
    Dim object_Notes As Object
    Set object_Notes = CreateObject("Notes.NotesSession")
    '指定資料庫
    Dim object_Stream As Object
    Set object_Stream = object_Notes.CREATESTREAM
    '新增文件
    Dim object_document As Object
    Set object_document = object_Notes.CURRENTDATABASE.createDocument
    
    '不將內文轉成 RichText形式
    object_Notes.CONVERTMIME = False
    
    With object_document
        '收件人(to)
        .SendTo = Array("WeiCheng Lee/ASEK/ASE@ASE")
        '收件人(CC)
        .CopyTo = Array("WeiCheng Lee/ASEK/ASE@ASE")
        '信件標題
        .Subject = "VBA Test (Security C)"
        '機密等級(Security A/B/C/D)
        .SecurityLevel = "C"
        '格式指定
        .form = "Memo"
    End With
    
    
    '物件
    Dim object_MimeEntity As Object
    Set object_MimeEntity = object_document.CREATEMIMEENTITY
    '設定內文
    '寫Html(內文)
    Dim object_ContentEntity As Object
    Set object_ContentEntity = object_MimeEntity.CREATECHILDENTITY
    
    With object_ContentEntity
        object_Stream.WRITETEXT _
        "<html><head><p><font size=""3"">** Security C ** <br></p><br></head>" & _
        "<body><h2>Html<br></h2><p><font face=""微軟正黑體"", size=""3"">Image</font></p><img src=""cid:TestImage.jpg"" alt=""<圖片遺失！！>""><p>this is Test from VBA Send Notes</p><p><br>Thanks.</p><br><br></body>"
        .SETCONTENTFROMTEXT object_Stream, "text/HTML;charset=UTF-8", 1725
        object_Stream.Close
        object_Stream.TRUNCATE
    End With

    
    '圖片物件
    Dim object_ImageEntity As Object
    Set object_ImageEntity = object_MimeEntity.CREATECHILDENTITY
    '給圖片的存放路徑 & 名子
    With object_ImageEntity
        .CREATEHEADER("Content-ID").SETHEADERVAL "TestImage.jpg"
        object_Stream.Open ThisWorkbook.Path & "\DownloadData\TestImage.jpg", "binary"
        .SETCONTENTFROMBYTES object_Stream, "image/jpeg;name=""TestImage.jpg""", 1730   '<參考２><參考３>
        object_Stream.Close
        object_Stream.TRUNCATE
    End With
    
    
    '附件
    '跟圖片物件一樣，每一個附件都要在 object_MimeEntity 底下，建立一個子項目(childEntity)。然後在定義其參考等設定
    Dim object_FileEntity As Object
    Set object_FileEntity = object_MimeEntity.CREATECHILDENTITY

    With object_FileEntity
        .CREATEHEADER("Content-ID").SETHEADERVAL "Rowdata_(Security C).xlsx"
        object_Stream.Open ThisWorkbook.Path & "\DownloadData\Rowdata_(Security C).xlsx", "binary"
        .SETCONTENTFROMBYTES object_Stream, "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet;name=""Rowdata_(Security C).xlsx""", 1730
        object_Stream.Close
        object_Stream.TRUNCATE
    End With
    
    
    'ASE Notes後綴
    Dim object_Suffix As Object
    Set object_Suffix = object_MimeEntity.CREATECHILDENTITY

    With object_Suffix
        object_Stream.WRITETEXT _
        "<foot><br><br><p><font face=""Default Monospace"", size=""2"">WeiCheng Lee<br>ASE Group<br>Tel : [phone] # 87979<br>Email Address : [e-mail]</p>" & _
        "<p><font face=""Default Monospace"", size=""2"">----- ASE Confidentiality Notice -----<br>The preceding message (including any attachments) contains proprietary information that may be confidential, privileged, or constitute non-public information. It is to be read and used solely by the intended recipient(s) or <br>conveyed only to the designated recipient(s). If you are not an intended recipient of this message, please notify the author or sender immediately either by replying to this message or by telephone at 886-7-3617131 and delete <br>this message (including any attachments hereto) immediately from your system. You should not read ,retain, disseminate, distribute, copy or use this message in whole or in part for any purpose, not disclose all or any part of <br>its content to any other person.<br>----- ASE Confidentiality Notice -----</p></foot></html>"
        .SETCONTENTFROMTEXT object_Stream, "text/HTML;charset=UTF-8", 1725
        object_Stream.Close
        object_Stream.TRUNCATE
    End With
    
    
    '存取郵件
    object_document.SAVEMESSAGEONSEND = True
    '忽略錯誤
    On Error Resume Next
    '寄出Mail
    object_document.send False
End Sub

# PPT

Option Explicit

Sub Main_PPT()
    '(無關)資料來源
    Dim source_workbook As Workbook
    Set source_workbook = Workbooks.Open(ThisWorkbook.Path & "\DownloadData\Rowdata_(Security C).csv")
    Dim source_worksheet As Worksheet
    Set source_worksheet = source_workbook.Sheets("Rowdata_(Security C)")
    
    
    'PPT Main
    'include 函式庫 ， Create PPT file
    Dim object_PPT As Object
'   Dim object_PPT As Powerpoint.Application
    Set object_PPT = CreateObject("Powerpoint.Application")
    
    Dim presentation_PPT As Object
'   Dim presentation_PPT As Presentation    'presentation VS presentations
    Set presentation_PPT = object_PPT.Presentations.Add

    Dim slide_PPT As Object
'   Dim Slide_PPT As Slide
    Set slide_PPT = presentation_PPT.Slides.Add(1, ppLayoutBlank)   'ppLayoutBlank 暫時沒想到怎代替 (先/後 導入)
    
    
    '開始設定PPT
    object_PPT.ActiveWindow.ViewType = ppViewNormal
    presentation_PPT.PageSetup.SlideOrientation = msoOrientationHorizontal  '投影片方向 -> 橫向
    
    presentation_PPT.PageSetup.SlideSize = ppSlideSizeCustom    '投影片大小自訂
    presentation_PPT.PageSetup.SlideWidth = CMtoPixel(29.7)
    presentation_PPT.PageSetup.SlideHeight = CMtoPixel(21)
    presentation_PPT.PageSetup.FirstSlideNumber = 1
    
    presentation_PPT.SlideMaster.HeadersFooters.SlideNumber.Visible = msoTrue    '投影片可見 ; SlideMaster -> 投影片母片 ; HeadersFooters -> 頁首頁尾
    object_PPT.ActiveWindow.WindowState = ppWindowMaximized     'PPT畫面放最大
    
    
    '設定PPT投影片
    With presentation_PPT.Slides(1)
        '建立文字
        .Shapes.AddTextbox(msoTextOrientationHorizontal, _
            Left:=CMtoPixel(0.02), Top:=CMtoPixel(0.01), Width:=CMtoPixel(29.68), Height:=CMtoPixel(1.37)) _
            .TextFrame.TextRange = "Hello World！！！ 我我我"
        
        '設定(建立那一個文字的)字體格式
        With .Shapes(1).TextFrame.TextRange.Font
            .Name = "微軟正黑體"
            .Size = 26
            .Bold = msoTrue
        End With
        
        '建立圖片
        With source_worksheet
            .Activate
            '1.從Excel抓取Cells範圍當圖片
            range(.Cells(1, 1), .Cells(5, 16)).Copy
            Application.Wait (DateAdd("s", 1, Now))
            presentation_PPT.Slides(1).Shapes.Paste

            Application.Wait (DateAdd("s", 1, Now))
            With object_PPT.ActiveWindow.Selection.ShapeRange
                .Width = CMtoPixel(20)
                .Height = CMtoPixel(12.83)
                .Left = CMtoPixel(0.18)
                .Top = CMtoPixel(6.33)
            End With
            Application.Wait (DateAdd("s", 1, Now))
            '2.從Excel建立群組後，以圖片輸出  <- 能吃Excel圖表
            '在Excel事先建立 群組後
'           .Shapes.Range(Array("群組 1")).Copy
'           Application.Wait (DateAdd("s", 3, Now))
'           Presentation.Slides(1).Shapes.PasteSpecial (ppPasteJPG)
            '後面一樣，設定大小 (With object_PPT.ActiveWindow.Selection.ShapeRange...略)
        End With
    End With
    
    
    '儲存&關閉
    presentation_PPT.SaveAs ThisWorkbook.Path & "\Result\PPT_(Security C).pptx"
    object_PPT.ActiveWindow.Close
    
    
'    object_PPT.Quit
    Set object_PPT = Nothing
    
    source_workbook.Close
End Sub

Private Function CMtoPixel(digits)
    CMtoPixel = digits * 28.35     '28.35 -> cm 轉 Pixel (大概相符)
End Function

# SQL
## Main

Private Sub function_SQL()
    Dim SQL As New class_SQL
    SQL.Setting_fileSource = "D:\ASEKH\" & Environ("USERNAME") & "\RPA\(RPA)AutoPSN_Release(2900FCB)\PSNRawData_(Security C).xlsx"
    SQL.Setting_Code = "select  PSN_No, CUST from [Sheet1$] where (CUST <> 'QM' and CUST <> 'TP' and CUST <> 'TZ' and CUST <> 'T4')"
    SQL.Run range("B2"), False
'    Dim A As Object
'    Set A = SQL.Getting_Data
    SQL.Clear
End Sub

## class_SQL

'<備註>
'   1. 範例：
    '    Dim SQL As New class_SQL
    '    SQL.Setting_fileSource = "D:\ASEKH\" & Environ("USERNAME") & "\RPA\(RPA)AutoPSN_Release(2900FCB)\PSNRawData_(Security C).xlsx"
    '    SQL.Setting_Code = "select  PSN_No, CUST from [Sheet1$] where (CUST <> 'QM' and CUST <> 'TP' and CUST <> 'TZ' and CUST <> 'T4')"
    '    SQL.Run Range("B2"), False
    ''    Dim A As Object
    ''    Set A = SQL.Getting_Data
    '    SQL.Clear
'
'   2. (檔案來源) "D:\ASEKH\" & Environ("USERNAME") & "\RPA\(RPA)AutoPSN_Release(2900FCB)\PSNRawData_(Security C).xlsx"
'
'      (SQL指令) "select  PSN_No, CUST from [Sheet1$] where (CUST <> 'QM' and CUST <> 'TP' and CUST <> 'TZ' and CUST <> 'T4')"
'
'
'   3. 三種用法：(1) 正常帶入值 (bool_Field = True or 不輸入) -> 依序輸入標頭
'                (2)            (bool_Field = false)          -> 不輸入標頭
'                (3) 皆無帶入值 -> 可以用Getting_Data取得資料，後續自定義執行


Option Explicit

Dim object_SQL_Connect As Object, object_SQL_Data As Object
Dim str_SQL_Connect As String, str_SQL_Code As String, str_fileSource As String
Dim int_i As Integer


'輸入/更改參值 (檔案來源, SQL指令) <註1>
Public Property Let Setting_fileSource(inputStr_fileSource As String)
    str_fileSource = inputStr_fileSource
End Property
Public Property Let Setting_Code(inputStr_SQL_Code As String)
    str_SQL_Code = inputStr_SQL_Code
End Property


''取得參值 ()
'Public Property Get Getting_Data() As Object
'    Getting_Data = object_SQL_Data
'End Property


'開始執行程式   ps:使用完畢要記得釋放記憶體 <註2>
Public Sub Run(Optional range_location As range, Optional bool_Field As Boolean = True)
    If object_SQL_Connect Is Nothing Then
        Set object_SQL_Connect = CreateObject("adodb.connection")
    Else
        object_SQL_Connect.Close
    End If
    
    '不知道為啥CSV不能直接打開(後面的str_SQL_Connect賦值)，這邊裝個擴充防呆吧；順便把txt用csv輸入的地方一起 <擴充1>
    Dim workbook_EMS As Workbook
    Dim bool_open As Boolean
    bool_open = False
    If Right(str_fileSource, 4) = ".csv" Or Right(str_fileSource, 4) = ".CSV" Then
        Set workbook_EMS = Workbooks.Open(str_fileSource)
        bool_open = True
    End If
    'txt打開 -> 待擴充
    'AAA
    
    '正式
    If Application.Version < 12 Then
        str_SQL_Connect = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & str_fileSource
    Else
        str_SQL_Connect = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & str_fileSource
    End If
    object_SQL_Connect.Open str_SQL_Connect

    Set object_SQL_Data = object_SQL_Connect.Execute(str_SQL_Code)
    
    If Not range_location Is Nothing Then
        If bool_Field Then
            For int_i = 0 To object_SQL_Data.Fields.Count - 1
                range_location.Cells(1, int_i + 1) = object_SQL_Data.Fields(int_i).Name
            Next
            range_location.Offset(1).CopyFromRecordset object_SQL_Data
        Else
            range_location.CopyFromRecordset object_SQL_Data
        End If
    End If
    
    '<擴充1-後段>
    If bool_open = True Then
        workbook_EMS.Close SaveChanges:=False
    End If
End Sub


'結束時釋放記憶體
Public Sub Clear()
    object_SQL_Connect.Close
    Set object_SQL_Connect = Nothing
    Set object_SQL_Data = Nothing
End Sub




'更新紀錄
'初版：2024/05/02    By  WeiCheng_Lee

# Workbook 儲存範圍轉圖片抓取
## Main

Private Sub Sub_CacheChart()
    Dim CacheChart As New class_CacheChart
'    CacheChart.Setting_range = range("A1:A1")
    CacheChart.Setting_FileFolder = "C:\Users\K17805\Downloads\新增資料夾\"
'    CacheChart.Setting_FileName = "ABC.jpg"
    Call CacheChart.Run(range("A1:A1"), "ABC.jpg")
End Sub

## class_CacheChart

'<備註>
'   1. 範例：
    '    Dim CacheChart As New class_CacheChart
    '
    '    With worksheet_CHART
    '        .Activate
    '
    '        CacheChart.Setting_FileFolder = GlobalValue.str_ResultDataFolder
    '
    '
    '        CacheChart.Run .Range("A2:P26"), str_Chart1_Name
    '
    '        CacheChart.Run .Range("A59:P75"), str_Chart2_Name
    '
    '    End With



'   2. 截圖要抓到主頁面，才能擷取
'   3. 檔案名稱，這邊鎖死JPG (可擴充)


Option Explicit

'Dim rng As Range
Dim shp As shape
Dim nm$, myFolder$
'Dim nm$, myFolder$, pictureName$      '末尾$是字串的意思 (As String)


'輸入/更改參值 (擷取範圍，資料夾路徑，檔案名稱)
'Public Property Let Setting_range(input_rng As Range)
'    rng = input_rng
'End Property
Public Property Let Setting_FileFolder(inputStr_Folder As String)
    myFolder$ = inputStr_Folder
End Property
'Public Property Let Setting_FileName(inputStr_FileName As String)
'    pictureName$ = inputStr_FileName
'End Property


Public Sub Run(input_Range As range, inputStr_FileName As String)
    input_Range.Copy
    
    ActiveSheet.Pictures.Paste
    
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 13 Then
            If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                MkDir myFolder
            End If
            
            shp.CopyPicture
            With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
                    .Parent.Select
                    .Paste
                    .Export myFolder & inputStr_FileName, "JPG"
                    .Parent.Delete
            End With
            shp.Delete
        End If
    Next
    
End Sub




'更新紀錄
'初版：2024/05/02    By  WeiCheng_Lee

# 將檔案轉UTF-8

Sub ConvertToUTF8(strInput_Path, strInput_Name)

    Dim command_shell As Variant
    Dim code As String
    
    code = "PowerShell -Command " & "&{Get-Content '" & strInput_Path & "\" & strInput_Name _
            & "' | Set-Content -Encoding utf8 '" & strInput_Path & "\utf8_" & strInput_Name & "'}"
    
    command_shell = Shell(code, vbNormalFocus)
    
    Sleep 8000

End Sub

# 去除Worksheet底部空白

'去Excel工作表底部，空白儲存格 (似乎會發生在去重複之後，Excel內部殘值? 總之先試看看)
Sub DeleteBlankCell_FromWorksheet(worksheet_Current As Worksheet, long_lastRow As Long)
    
    With worksheet_Current
        
        .Activate
        
        If long_lastRow < 1048576 Then .Rows(CStr(long_lastRow + 1) & ":1048576").Delete Shift:=xlUp
        
    End With
    
End Sub

# 列行字母&列行數轉換
## 行數轉字母

Function Column_DigitToChar(ByVal Col_Dig As Variant) 'Int 、 Long
    Column_DigitToChar = Replace(Cells(1, Col_Dig).Address(False, False), "1", "")
End Function

## 字母轉行數

Function Column_CharToDigit(ByVal Col_Chr As String) As Long
    Dim i As Long, colNum As Long
    colNum = 0
    For i = 1 To Len(Col_Chr)
        colNum = colNum * 26 + Asc(UCase(Mid(Col_Chr, i, 1))) - 64
    Next i
    Column_CharToDigit = colNum
End Function

# 取得最後行列數
## 最後 Row

Function GetLastRow(Optional inputStr_Range As String = "A1") As Long
    If Range(inputStr_Range).Value <> "" Then
        GetLastRow = Cells.Find(What:="*", _
                    After:=Range(inputStr_Range), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
    Else
        GetLastRow = 1
    End If
End Function

## 最後 Column

Function GetLastColumn(Optional inputStr_Range As String = "A1") As Long
    If Range(inputStr_Range).Value <> "" Then
        GetLastColumn = Cells.Find(What:="*", _
                    After:=Range(inputStr_Range), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Column
    Else
        GetLastColumn = 1
    End If
End Function

# Excel執行初始/結束設定
## 開始設定

Sub Close_Excel_fuction_for_efficiency()
    Application.ScreenUpdating = False      '(不)顯示螢幕更新
    Application.DisplayStatusBar = False    '(不)顯示狀態列
    Application.EnableEvents = False        '(不)物件觸發事件
    Application.DisplayAlerts = False       '(不)顯示對話視窗
    Application.AskToUpdateLinks = False    '不顯示更新
    Application.Calculation = xlCalculationManual   '(不)顯示Excel公式更新
End Sub

## 結束設定

Sub Open_Excel_fuction_for_EndVBA()
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub

# 呼叫Excel公式
## Match & Index

For int_i = int_CurrentRow_Destination To int_lastRow_Destination

    int_temp = Application.Match(.Cells(int_i, Column_CharToDigit("C")).Value, Worksheets("WIP").Columns("I:I"), 0)

    .Cells(int_i, Column_CharToDigit("CE")) = Application.Index(Worksheets("WIP").Columns("F:F"), int_temp)
    .Cells(int_i, Column_CharToDigit("CF")) = Application.Index(Worksheets("WIP").Columns("G:G"), int_temp)
    .Cells(int_i, Column_CharToDigit("CJ")) = Application.Index(Worksheets("WIP").Columns("J:J"), int_temp)
    .Cells(int_i, Column_CharToDigit("CK")) = Application.Index(Worksheets("WIP").Columns("K:K"), int_temp)
    .Cells(int_i, Column_CharToDigit("DC")) = Application.Index(Worksheets("WIP").Columns("M:M"), int_temp)
    
Next

# 判斷檔案是否被開啟

Function IsFileOpen(filePath As String) As Boolean
    On Error Resume Next
    Open filePath For Input Lock Read As #1
    IsFileOpen = (Err <> 0)
    Close #1
    On Error GoTo 0
End Function

# 網頁爬蟲
## IE
### 前文
> VBA唯一不需外部插件，可讀取網站動態JS的功能
使用CreateObject("InternetExplorer.Application")

Dim IE As Object    
Set IE = CreateObject("InternetExplorer.Application")

> 本身動態/靜態讀取皆支持

| 方法比較 | 特性 | 觸發網頁 JS 事件 | 適用情境 |
| ----- | ----- | ----- | ----- |
| **VBA 直接操作 IE DOM **<br>`IE.Document.getElementById("username").Value = "myUser"` | 靜態、執行效率高 | 否 | 大多數標準表單輸入 |
| **在網頁執行 JavaScript**<br>`execScript "document.getElementById('username').value='myUser'"` | 動態、可操作網頁 | 是 | 須模擬使用者行為的情境 |
### IE.Visible
> True/False : 顯示瀏覽器視窗/於背景執行

IE.Visible = True

### IE.navigate
> 前往指定網頁
通常會搭配網頁載入偵測使用

IE.navigate "http://myvf.kh.asegroup.com/vf/root/"

Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop

### IE.Busy
> True/False : IE 正在進行網路請求或載入資源/目前沒有進行載入動作
### IE.readyState
> IE 載入狀態，回傳 int
### DoEvents
> 讓 VBA 暫時把控制權交回給系統，允許其他事件（例如瀏覽器繼續載入）正常運作。
p.s. async非同步的概念，沒有這行，迴圈可能「卡住」導致 Excel 停止回應（Not Responding）。
### IE.document.parentWindow.execScript
> 操作網頁JS執行指令

IE.document.parentWindow.execScript "location.href='https://myvf.kh.asegroup.com:18181/webrpt/home_page.asp'"

IE.document.parentWindow.execScript "document.getElementById('username') = myUser"

IE.document.parentWindow.execScript "document.getElementById('div_tab').children[0].children[1].children[5].children[2].children[1].value = '070000'"

IE.document.parentWindow.execScript "document.getElementById('div_tab').children[0].children[1].children[5].children[5].children[0].value = '" & curT & "'"

'網站定義函數 "查詢"
IE.document.parentWindow.execScript "runquery();"

### 實際應用 - 複製網頁資訊，從剪貼簿取得至VBA
> JS 原本語法

var str = document.querySelector("#form1 > div.card.bg-light.mb-3 > div.card-body > button").innerText; 
btn();
function btn() {
    var value = str;
    var el = document.createElement('textarea');
    el.value = value;
    document.body.appendChild(el);
    el.select();
    document.execCommand('copy');
    document.body.removeChild(el);
};

> 更改成 VBA 語法 (code那段的元素路徑會更改)

Const Copycode = "btn();" _
                & "function btn() {" _
                & "var value = str;" _
                & "var el = document.createElement('textarea');" _
                & "el.value = value;" _
                & "document.body.appendChild(el);" _
                & "el.select();" _
                & "document.execCommand('copy');" _
                & "document.body.removeChild(el);};"


'將網站查詢結果，抓到剪貼簿
code = "var str = document.getElementById('div_data').innerText;" & Copycode
IE.document.parentWindow.execScript code
Sleep 500

'從剪貼簿抓資料 (下載 / data not found)，存到VBA裡面
objData.GetFromClipboard    '使用物件呼叫當前剪貼簿資料
str = objData.GetText()     '將物件資料，儲存到$str

# 從剪貼簿取值
> 使用 MSForms.DataObject (VBA的剪貼物件)

Dim objData As New MSForms.DataObject
objData.GetFromClipboard    '使用物件呼叫當前剪貼簿資料
str = objData.GetText()     '將物件資料，儲存到$str

# API 呼叫
> 會因呼叫網站功能不同，導致mydata寄送的內容有相異

Sub Event_Hub_Api(str_Token As String, Optional str_value As String = "")
    
    Dim httpsource As Object
    Set httpsource = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' 對目標網址執行 POST 命令
    httpsource.Open "POST", "https://eventhub.kh.asegroup.com/v1/web_api/", False
    
    Dim mydata As String
    
    ' vba 的 json
    mydata = "{""token"": """ & str_Token & """,""event_data"": {""value1"": """ & str_value & """}}"
    
    ' 送出命令並接收資料
    httpsource.send mydata
    
    Set httpsource = Nothing
    
End Sub

# 更改圖片大小

'更改圖片大小，強化Note文字清晰度 (因為公司的信箱沒辦法讀取CSS縮放格式，自動調整高度 height : auto)
Public Sub ResizeJPG_PowerShell(str_FilePath As String, Optional long_widthPixcel As Long = 1800)
    
    Dim wsh As Object
    Dim psCmd As String
    
    '<防呆> 檢查路徑是否存在
    If Dir(str_FilePath) = "" Then Err.Raise vbObjectError + 5487, "ResizeJPG_PowerShell", "未發現檔案路徑" & vbCrLf & str_FilePath
    
    ' 執行 PowerShell 並等待完成
    psCmd = "powershell -NoProfile -Command " & _
            """Add-Type -AssemblyName System.Drawing; " & _
            "$img = [System.Drawing.Image]::FromFile('" & str_FilePath & "'); " & _
            "$ratio = " & CStr(long_widthPixcel) & " / $img.Width; " & _
            "$newH = [int]($img.Height * $ratio); " & _
            "$bmp = New-Object System.Drawing.Bitmap(" & CStr(long_widthPixcel) & ", $newH); " & _
            "$gfx = [System.Drawing.Graphics]::FromImage($bmp); " & _
            "$gfx.DrawImage($img, 0, 0, " & CStr(long_widthPixcel) & ", $newH); " & _
            "$img.Dispose(); $gfx.Dispose(); " & _
            "$bmp.Save('" & str_FilePath & "', [System.Drawing.Imaging.ImageFormat]::Jpeg); $bmp.Dispose();"""
    
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run psCmd, 0, True      '0=隱藏PowerShell視窗, True=VBA 等待 PowerShell 完成後才繼續
    
    Set wsh = Nothing
    
    '<防呆> 檢查路徑是否存在
    If Dir(str_FilePath) = "" Then Err.Raise vbObjectError + 5487, "ResizeJPG_PowerShell", "縮放後圖片未生成，請檢查 PowerShell 環境" & vbCrLf & str_FilePath
    
End Sub

# 擷取儲存格，轉成圖片

'<備註>
'   1. 範例：
'    Dim CacheChart As New class_CacheChart
'
'    CacheChart.Setting_FileFolder = str_Folder_Chart
'
'    Call CacheChart.Run(range_CacheChart, str_fileName)

'   2. 檔案名稱，這邊鎖死JPG (可擴充)


Option Explicit

Dim shp As Shape
Dim nm$, myFolder$      '末尾$是字串的意思 (As String)


'輸入/更改參值 (資料夾路徑)
Public Property Let Setting_FileFolder(inputStr_Folder As String)
    myFolder$ = inputStr_Folder
End Property


Public Sub Run(input_Range As Range, inputStr_FileName As String)
    
    Dim chtObj As ChartObject
    Dim timeout As Double
    
    Set chtObj = worksheet_Marco.ChartObjects.Add(0, 0, input_Range.Width, input_Range.Height)
    
    timeout = Timer + 120
    Do
        On Error Resume Next
        input_Range.CopyPicture xlScreen, xlPicture
        If Err.Number = 0 Then Exit Do
        DoEvents
        If Timer > timeout Then Exit Do
    Loop
    On Error GoTo 0
    
    ' 將圖片貼到圖表中
    chtObj.Activate
    chtObj.Chart.Paste
    
    timeout = Timer + 10
    Do While chtObj.Chart.Shapes.Count = 0
        DoEvents
        If Timer > timeout Then Exit Do
    Loop
    
    ' 匯出為 JPG
    chtObj.Chart.Export Filename:=myFolder & inputStr_FileName, FilterName:="JPG"
    
    ' 刪除暫存物件
    chtObj.Delete
    
    ' 後處理：縮放
    Call ResizeJPG_PowerShell(myFolder & inputStr_FileName)
    
    Set chtObj = Nothing
    
End Sub

## HBPOP OS Summary 工具原工程師寫法

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub TXT匯入(Optional ByVal inputStr_FilePath As String = "")
'
' TXT匯入
'
' 快速鍵: Ctrl+w
'
    Dim myFolder$
    Sheets("Raw").Select
    
    
    If inputStr_FilePath <> "" Then
        myFolder$ = inputStr_FilePath
    Else
        myFolder$ = InputBox("輸入路徑(TXT)")
    End If
    

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & myFolder$ _
        , Destination:=Range("$A$1"))
        '.CommandType = 0
        .name = myFolder$
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 950
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileOtherDelimiter = "("
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.AutoFilter
    Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveSheet.Range("$A$1:$W$340").AutoFilter Field:=2, Criteria1:="=DUT", _
        Operator:=xlOr, Criteria2:="=Fail"
    Columns("B:Y").Select
    Selection.ColumnWidth = 5
    Cells.Select
    Sheets("Button").Select

End Sub
Sub Screenshot(Optional ByVal inputStr_ScheduleName As String = "", Optional bool_ChartOutput As Boolean = True)
    Dim i, j, LC As Integer
    Dim rng, rng_1 As Range
    Dim shp As shape
    Dim nm$, myFolder$, pictureFullName$, pictureName$, name$, folder$, SI, Bump, SI_1, Bump_1
    
    
    Dim bool_Open_ToTemp As Boolean '判斷是手動執行還是自動執行 (手動執行沒有temp分頁，也不用匯入資訊到總表)
    
    If ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).name <> "temp" Then
        bool_Open_ToTemp = False
    Else
        bool_Open_ToTemp = True
    End If
    
    Dim worksheet_temp As Worksheet
    Dim strArray_temp() As String
    If bool_Open_ToTemp Then Set worksheet_temp = Worksheets("temp")
    
    
    Sheets("Raw").Range("A1") = "=COUNTIFS(B:B,""Fail"")"
    
    If Sheets("Raw").Range("A1") = 0 Then
            Sheets("Raw").Select
            Last_Data_Row = Sheets("Raw").Cells(Rows.Count, "B").End(xlUp).Row
            Sheets("Raw").Range("A2:A" & Last_Data_Row) = "=CONCATENATE(LEFT(RC[7],1),RC[3])"
            
            '編碼
            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8, Criteria1:="Short"
            allrowscount = ActiveSheet.UsedRange.Rows.Count '篩選後個數
            Range("D1:D" & allrowscount) = "=COUNTIFS(C[4],""Short"",C[-2],""DUT"")-COUNTIFS(R[1]C[4]:R[1500]C[4],""Short"",R[1]C[-2]:R[1500]C[-2],""DUT"")"
            
            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8, Criteria1:="Open"
            allrowscount = ActiveSheet.UsedRange.Rows.Count '篩選後個數
            Range("D1:D" & allrowscount) = "=COUNTIFS(C[4],""Open"",C[-2],""DUT"")-COUNTIFS(R[1]C[4]:R[1500]C[4],""Open"",R[1]C[-2]:R[1500]C[-2],""DUT"")"
            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8
        
            
            Cells.Select
            Selection.Copy
            Sheets("Rawdata").Select
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                
            name$ = Sheets("Button").Range("F2").Value
            
            
            If inputStr_ScheduleName <> "" Then
                folder$ = inputStr_ScheduleName
            Else
                folder$ = InputBox("輸入資料夾名稱")
            End If
    
    
            myFolder = name$ & "\" & folder$ & "\" '資料夾路徑(要改)
        
            LC = Sheets("Button").Range("F4").Value
            Last_Data_Row = Sheets("Rawdata").Cells(Rows.Count, "B").End(xlUp).Row
            For i = 2 To Last_Data_Row
                
                If Sheets("Rawdata").Range("I" & i) > LC Then
                    Sheets("Rawdata").Range("J" & i & ",L" & i & ",N" & i & ",P" & i & ",R" & i & ",T" & i & ",V" & i & ",X" & i & ",Z" & i).Copy
                    SI_1 = Sheets("Button").Range("F11").Value
                    Sheets("SI").Range(SI_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Bump_1 = Sheets("Button").Range("F12").Value
                    Sheets("Bump").Range(Bump_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    
                    If bool_ChartOutput Then
                        SI = Sheets("Button").Range("F7").Value
                        Set rng = Sheets(3).Range(SI)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & ".jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng.CopyPicture
                        
                        With Sheets("SI").ChartObjects.Add(0, 0, rng.Width, rng.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    
                        Bump = Sheets("Button").Range("F8").Value
                        Set rng_1 = Sheets("BUMP").Range(Bump)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & "-1.jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng_1.CopyPicture
                        
                        With Sheets("BUMP").ChartObjects.Add(0, 0, rng_1.Width, rng_1.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    End If
                    
                Else
                    Sheets("Rawdata").Range("J" & i & ",L" & i & ",N" & i & ",P" & i & ",R" & i & ",T" & i & ",V" & i & ",X" & i & ",Z" & i).Copy
                    Bump_1 = Sheets("Button").Range("F12").Value
                    Sheets("Bump").Range(Bump_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    
                    If bool_ChartOutput Then
                        Bump = Sheets("Button").Range("F8").Value
                        Set rng_1 = Sheets("BUMP").Range(Bump)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & ".jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng_1.CopyPicture
                        
                        With Sheets("SI").ChartObjects.Add(0, 0, rng_1.Width, rng_1.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    End If
                    
                End If
                
                
                'Ver 2.0  Get defectLocation Data Array
                If bool_Open_ToTemp Then
                    strArray_temp = Main2.GetStringArray_ByDefectLocation()
                    worksheet_temp.Cells(i - 1, 1).Resize(1, UBound(strArray_temp)).Value = strArray_temp
                End If
                
            Next i
        
            Sheets("Button").Select

    Else
            Sheets("Raw").Select
            Last_Data_Row = Sheets("Raw").Cells(Rows.Count, "B").End(xlUp).Row
            Sheets("Raw").Range("A2:A" & Last_Data_Row) = "=IF(RC[1]=""Fail"",CONCATENATE(LEFT(R[-1]C[7],1),R[-1]C[3]),CONCATENATE(LEFT(RC[7],1),RC[3]))"
            
            '編碼
            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8, Criteria1:="Short"
            allrowscount = ActiveSheet.UsedRange.Rows.Count '篩選後個數
            Range("D1:D" & allrowscount) = "=COUNTIFS(C[4],""Short"",C[-2],""DUT"")-COUNTIFS(R[1]C[4]:R[1500]C[4],""Short"",R[1]C[-2]:R[1500]C[-2],""DUT"")"
            
            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8, Criteria1:="Open"
            allrowscount = ActiveSheet.UsedRange.Rows.Count '篩選後個數
            Range("D1:D" & allrowscount) = "=COUNTIFS(C[4],""Open"",C[-2],""DUT"")-COUNTIFS(R[1]C[4]:R[1500]C[4],""Open"",R[1]C[-2]:R[1500]C[-2],""DUT"")"
            

            ActiveSheet.Range("$A$1:$W$1500").AutoFilter Field:=8
            ActiveSheet.Range("$A$1:$Y$1500").AutoFilter Field:=2, Criteria1:="Fail"
            
            Cells.Select
            Selection.Copy
            Sheets("Rawdata").Select
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            
            name$ = Sheets("Button").Range("F2").Value
            
            
            If inputStr_ScheduleName <> "" Then
                folder$ = inputStr_ScheduleName
            Else
                folder$ = InputBox("輸入資料夾名稱")
            End If
    
    
            myFolder = name$ & "\" & folder$ & "\" '資料夾路徑(要改)
        
            Last_Data_Row = Sheets("Rawdata").Cells(Rows.Count, "B").End(xlUp).Row
            
            LC = Sheets("Button").Range("F4").Value
            For i = 2 To Last_Data_Row
            
                If Sheets("Rawdata").Range("E" & i) > LC Then
                    
                    Sheets("Rawdata").Range("F" & i & ",H" & i & ",J" & i & ",L" & i & ",N" & i & ",P" & i & ",R" & i & ",T" & i & ",V" & i & ",X" & i).Copy
                    SI_1 = Sheets("Button").Range("F11").Value
                    Sheets("SI").Range(SI_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Bump_1 = Sheets("Button").Range("F12").Value
                    Sheets("Bump").Range(Bump_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    
                    If bool_ChartOutput Then
                        SI = Sheets("Button").Range("F7").Value
                        Set rng = Sheets("SI").Range(SI)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & ".jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng.CopyPicture
                        
                        With Sheets("SI").ChartObjects.Add(0, 0, rng.Width, rng.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    
                        Bump = Sheets("Button").Range("F8").Value
                        Set rng_1 = Sheets("BUMP").Range(Bump)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & "-1.jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng_1.CopyPicture
                        
                        With Sheets("BUMP").ChartObjects.Add(0, 0, rng_1.Width, rng_1.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    End If
                    
                Else
                    Sheets("Rawdata").Range("F" & i & ",H" & i & ",J" & i & ",L" & i & ",N" & i & ",P" & i & ",R" & i & ",T" & i & ",V" & i & ",X" & i).Copy
                    Bump_1 = Sheets("Button").Range("F12").Value
                    Sheets("Bump").Range(Bump_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    
                    If bool_ChartOutput Then
                        Bump = Sheets("Button").Range("F8").Value
                        Set rng_1 = Sheets(2).Range(Bump)
                        
                        If Len(Dir(myFolder, vbDirectory)) = 0 Then '若myFolder不存在則新增資料夾
                            MkDir myFolder
                        End If
                        pictureName = Sheets("Rawdata").Range("A" & i).Value
                        pictureFullName = pictureName & ".jpg"
                        Sleep (double_ChartSleepTime * 1000)
                        rng_1.CopyPicture
                        
                        With Sheets("SI").ChartObjects.Add(0, 0, rng_1.Width, rng_1.Height).Chart
                                .Parent.Select
                                .Paste
                                .Export myFolder & "\" & pictureFullName
                                .Parent.Delete
                        End With
                    End If
                    
                End If
                
                
                'Ver 2.0  Get defectLocation Data Array
                If bool_Open_ToTemp Then
                    strArray_temp = Main2.GetStringArray_ByDefectLocation()
                    worksheet_temp.Cells(i - 1, 1).Resize(1, UBound(strArray_temp)).Value = strArray_temp
                End If
                
            Next i
        
            Sheets("Button").Select

    End If
End Sub
Sub 清除()
    Sheets("Rawdata").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Raw").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    
    Dim shp As shape
    For Each shp In Sheets("Raw").Shapes
        shp.Delete
    Next shp
    
    Sheets("Button").Select
End Sub

GPT 說明

非常好 👍
你提供的這段 VBA 程式主要是用來 從 TXT 檔案匯入資料到「Raw」工作表，再進行格式處理與篩選。
以下是完整、清楚的逐行說明與邏輯分析，方便你日後維護或修改。

📘 程式說明：Sub TXT匯入(Optional ByVal inputStr_FilePath As String = "")
🔹 功能概要

這支程式會：

讓使用者輸入或指定 TXT 檔案路徑。

將該 TXT 檔案的內容匯入到 Raw 分頁中。

進行基本清理、篩選、欄寬調整。

最後切換回 Button 分頁。

🔹 逐步說明
Sub TXT匯入(Optional ByVal inputStr_FilePath As String = "")


宣告一個名為「TXT匯入」的子程序。

參數 inputStr_FilePath 是可選的，若有傳入值，就直接用來指定檔案路徑；若沒傳，會跳出輸入框讓使用者自行輸入。

Dim myFolder$
Sheets("Raw").Select


宣告變數 myFolder（字串型態）用來存放檔案路徑。

將目前工作表切換到 Raw，準備匯入資料。

If inputStr_FilePath <> "" Then
    myFolder$ = inputStr_FilePath
Else
    myFolder$ = InputBox("輸入路徑(TXT)")
End If


若外部呼叫時已傳入檔案路徑，則直接使用該路徑。

否則顯示一個輸入框，讓使用者手動輸入 TXT 檔案路徑。

With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myFolder$ _
    , Destination:=Range("$A$1"))


使用 QueryTables.Add 建立一個「資料查詢連線」，
將 TXT 檔案作為資料來源，匯入至 A1 起始的儲存格。

接下來這一段是設定 匯入參數與格式：

    .Name = myFolder$
    .FieldNames = True
    .RowNumbers = False
    .PreserveFormatting = True
    .RefreshStyle = xlInsertDeleteCells
    .TextFilePlatform = 950
    .TextFileParseType = xlDelimited
    .TextFileConsecutiveDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = True
    .TextFileOtherDelimiter = "("
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

重點：

.TextFilePlatform = 950 → 指定使用 繁體中文 (Big5) 編碼。

.TextFileParseType = xlDelimited → 以「分隔符號」解析 TXT。

.TextFileTabDelimiter、.TextFileCommaDelimiter、.TextFileSemicolonDelimiter、.TextFileOtherDelimiter 等
→ 同時允許多種分隔符號（Tab、逗號、分號、空格、括號）。

.Refresh → 實際執行匯入。

Cells.Select
Selection.AutoFilter
Selection.Replace What:=")", Replacement:=""


對整張表套用篩選。

將所有 ) 替換成空白（刪除右括號）。