#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