UTF-8ファイル処理のバックアップ(No.1)

バックアップ一覧
差分を表示
現在との差分を表示
ソースを表示
UTF-8ファイル処理へ行く。
- 1 (2022-07-10 (日) 20:35:49)

【 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

UTF-8ファイル処理 のバックアップ(No.1)