UTF-8ファイル処理
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
]
開始行:
[[【 UTF-8ファイル処理 】]]
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...
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, HTMCHKENDWO...
Exit Do
ElseIf InStr(strSht1WAStkTxt, HTMCHKS...
blnLoop = True
lngCols = 1
ElseIf InStr(strSht1WAStkTxt, HTMROWS...
lngRows = lngRows + 1
lngCols = 1
ElseIf blnLoop Then
If InStr(strSht1WAStkTxt, HTMCHKC...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
End If
End If
Loop
.Close
End With
End If
Next
WSTHRES.Activate
終了行:
[[【 UTF-8ファイル処理 】]]
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...
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, HTMCHKENDWO...
Exit Do
ElseIf InStr(strSht1WAStkTxt, HTMCHKS...
blnLoop = True
lngCols = 1
ElseIf InStr(strSht1WAStkTxt, HTMROWS...
lngRows = lngRows + 1
lngCols = 1
ElseIf blnLoop Then
If InStr(strSht1WAStkTxt, HTMCHKC...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
ElseIf InStr(strSht1WAStkTxt, HTM...
WSTHRES.Cells(lngRows, lngCol...
lngCols = lngCols + 1
End If
End If
Loop
.Close
End With
End If
Next
WSTHRES.Activate
ページ名: