#author("2022-07-10T20:35:49+09:00","","")
#author("2022-07-10T20:36:55+09:00","","")
[[【 UTF-8ファイル処理 】]]

Private Sub Worksheet_Activate()
    
    
    
    Dim strSht1WAStkTxt As String
    Dim varAry As Variant
    Dim lngRows As Long
    Dim lngCols As Long
    Dim blnLoop As Boolean
    Dim blnGetTxt As Boolean
    
    
    '###   フォルダ内のファイル一覧を取得してデータを抽出   ###'
    
    lngRows = 1
    Set fdDir = objFS.GetFolder(WBTH.Path)
    For Each flHtm In fdDir.Files
        If objFS.GetExtensionName(flHtm.Name) = "html" Or objFS.GetExtensionName(flHtm.Name) = "htm" Then
            With CreateObject("ADODB.Stream")
                .Type = adTypeText
                .Charset = "UTF-8"
                .LineSeparator = adLF
                .Open
                .LoadFromFile flHtm.Path
                blnLoop = False
                Do Until .EOS
                    strSht1WAStkTxt = .ReadText(adReadLine)
                    If InStr(strSht1WAStkTxt, HTMCHKENDWORD) > 0 Then
                        Exit Do
                    ElseIf InStr(strSht1WAStkTxt, HTMCHKSRTWORD) > 0 Then
                        blnLoop = True
                        lngCols = 1
                    ElseIf InStr(strSht1WAStkTxt, HTMROWS1WORD) > 0 Then
                        lngRows = lngRows + 1
                        lngCols = 1
                    ElseIf blnLoop Then
                        If InStr(strSht1WAStkTxt, HTMCHKCOL1WORD) > 0 Then
                            WSTHRES.Cells(lngRows, lngCols).Value = FCTREPKAIDAY(strSht1WAStkTxt, HTMCHKCOL1WORD)
                            lngCols = lngCols + 1
                        ElseIf InStr(strSht1WAStkTxt, HTMCHKCOL2WORD) > 0 Then
                            WSTHRES.Cells(lngRows, lngCols).Value = FCTREPKAIDAY(strSht1WAStkTxt, HTMCHKCOL2WORD)
                            lngCols = lngCols + 1
                        ElseIf InStr(strSht1WAStkTxt, HTMCHKCOL3WORD) > 0 Then
                            WSTHRES.Cells(lngRows, lngCols).Value = FCTREPKAIDAY(strSht1WAStkTxt, HTMCHKCOL3WORD)
                            lngCols = lngCols + 1
                        ElseIf InStr(strSht1WAStkTxt, HTMCHKCOL4WORD) > 0 Then
                            WSTHRES.Cells(lngRows, lngCols).Value = FCTREPKAIDAY(strSht1WAStkTxt, HTMCHKCOL4WORD)
                            lngCols = lngCols + 1
                        End If
                    End If
                Loop
                .Close
            End With
        End If
    Next
    
    
    WSTHRES.Activate
    
    
    
End Sub

トップ   編集 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS