VBAでフォルダ内のhtmlファイルを読み込みたい

質問

フォルダ内のhtmlファイルをテキストで読み込んで、
一部修正を行いたいと思っています。

いろいろ調べて、ExcelVBAやAccessVBAで試してみたのですが、
フォルダ内のファイルを認識しないのか、読み込んでくれませんでした。

バージョンは2003です。

良い方法があれば、教えていただけると大変助かります。

よろしくお願いいたします。

回答No.2

nda23

直感的にイヤなコードがあります。
>GoTo Exit_GetTextInformation
GoToは使うべきではありません。しかも、このラベルに
分岐する所が３ヶ所あって、いずれの理由で分岐するか
わかりません。
>If .FoundFiles.Count = 0 Then GoTo
WithブロックからWithブロック外への分岐も、とても
気持ち悪いコードです。

当方で試しましたが、やはり正しいパスが指定されれば
正しく処理されます。どこでExit_GetTextInformationに
分岐するか調べたでしょうか？

サンプル
★既存のデータ定義
Dim ファイル集合
Dim メッセージ As String
'GoToを避けるための制御
Do
　　★フォルダ名取得
　　If FolderName = "" Or FolderName = "False" Then
　　　　メッセージ = "キャンセルされました"
　　　　Exit Do
　　End If
　　★ディレクトリ確認
　　If Ret = "" Then
　　　　メッセージ = "該当フォルダがありません"
　　　　Exit Do
　　End If
　　★ファイル検索
　　With Application.FileSearch
　　　　中略
　　　　Set ファイル集合 = .FoundFiles
　　End With
　　If ファイル集合.Count = 0 Then
　　　　メッセージ = "ファイルが見つかりません"
　　　　Exit Do
　　End If
　　★各ファイルの処理
　　Open ファイル集合(i) For ～
Loop Until True
If メッセージ <> "" Then
　　MsgBox メッセージ
End If

お礼

早速ご回答いただき、ありがとうございます。
ExcelVBAを使ったことがないため、WEB上の情報をコピーして動かしていました。
いただいたサンプルで再度確認してみます。
後日、また報告させていただきます。

補足

先日はありがとうございました。
以下のように作り直してみました。

iFilename.Countがカウントされず、エラーになってしまいます。
「Microsoft Scripting Runtime」の参照設定もしてみたのですが、だめでした。

それから、Do ~ Loopもエラーになってしまうので、現在、コメントにしてあります。

お手すきの時に助けていただけると嬉しいです。
自分でも引き続き、調べながら、テストしてみます。

＊＊＊

Private Sub Button1_Click()

Dim msg As String
Dim FolderName As String
Dim Ret As String
Dim Buff As String
Dim FNum As Integer
Dim i As Long
Dim sFilename As String

msg = "検索するフォルダのパスを指定してください"
FolderName = Application.InputBox _
(msg, "テキスト情報取得", "d:\", Type:=2)

sFilename = Dir(FolderName & "\*.htm", vbNormal)

'InputBoxがキャンセル、空白で返された場合のエラー処理

'Do

'★フォルダ名取得
If FolderName = "" Or FolderName = "False" Then
msg = "キャンセルされました"
Exit Sub
End If

' '★ディレクトリ確認
' If Ret = "" Then
' msg = "該当フォルダがありません"
' Exit Do
' End If

'★ファイル検索
With Application.FileSearch
'中略
Set iFilename = .FoundFiles
If iFilename.Count = 0 Then
msg = "ファイルが見つかりません"
Exit Sub
End If

'★各ファイルの処理

FNum = FreeFile 'ファイル番号確保

i = 1
For i = 1 To .FoundFiles.Count

'テキストファイルから一行目を取得

Open .FoundFiles(i) For Input As FNum
Line Input #FNum, Buff
If FNum = "http://system06/" Then

' "http://system06/" = "\\system04\共有\KMP\"
Close FNum
End If
Next i

'Loop

If メッセージ <> "" Then
MsgBox メッセージ
End If

End With
End Sub

回答No.1

nda23

何か錯誤があるのでは？
正しくパスを指定すれば普通に入力できます。
但し、SJIS以外のコードで書かれたものは
Streamオブジェクトで変換しないと字化け
するので、正しく処理できません。

何をやって、どう上手くいかないのかを掲題
しないと的確な回答を得られませんよ。

お礼

ご回答、ありがとうございます。

以下、Excel VBAでのコードです。
パスが正しいことは確認したのですが、ファイル名を格納しません。
「検索できませんでした」という結果になります。

お時間のあるときにご確認いただけると助かります。
よろしくお願いいたします。

＊＊＊

Private Sub Button1_Click()

Dim Msg As String, FolderName As String
Dim Ret As String, Buff As String
Dim FNum As Integer, i As Long

Msg = "検索するフォルダのパスを指定してください"
FolderName = Application.InputBox _
(Msg, "テキスト情報取得", "d:\", Type:=2)

'InputBoxがキャンセル、空白で返された場合のエラー処理
If FolderName = "" Or FolderName = "False" Then _
GoTo Exit_GetTextInformation

'指定フォルダの存在確認
Ret = Dir(FolderName, vbDirectory)
If Ret = "" Then GoTo Exit_GetTextInformation

'ファイル検索
With Application.FileSearch
.NewSearch
.Filename = "*.html"
.FileType = msoFileTypeAllFiles
.LookIn = FolderName '指定フォルダ
.SearchSubFolders = False
.Execute '検索実行

'検索結果が0の場合終了
If .FoundFiles.Count = 0 Then GoTo Exit_GetTextInformation

FNum = FreeFile 'ファイル番号確保

For i = 1 To .FoundFiles.Count
'テキストファイルから一行目を取得
Open .FoundFiles(i) For Input As FNum
Line Input #FNum, Buff
Close FNum

'テキストファイルの情報をセルに書き込み
'Cells(i, 1) = Dir(.FoundFiles(i), vbNormal) 'ファイル名取得
'Cells(i, 2) = FileDateTime(.FoundFiles(i)) 'ファイル更新日
'Cells(i, 3) = Buff 'テキスト一行目

Next i

End With

Exit Sub

Exit_GetTextInformation:

MsgBox "検索できませんでした"

End Sub