Excelのマクロを実行しても、エラーメッセージもなく結果が真っ白

後述のようなExcelのマクロを作りました。

（前略）
<h3 class="itemListContents" data-soldOutFlug="N" data-exId="6418346"><!--(商品)-->
<a href="/shop/357136/4971710383515">商品A</a></h3>
（中略１）
<strong class="fontstyle1">卸価格203円/点(税抜)</strong>
（中略２）
<h3 class="itemListContents" data-soldOutFlug="Y" data-exId="6819716"><!--(商品)-->
<a href="/shop/357136/4902424437867">商品B</a></h3>
（中略３）
<strong class="fontstyle1">卸価格1,021円/点(税抜)</strong>
（後略）

のようなソースが含まれているhtmlファイルから、ExcelのＡ、Ｂ、Ｃ列に

4971710383515 商品A 203
4902424437867 商品B 1,021

という結果を表示するようになっているのですが、
私の環境では正常に動作するのですが、他の人の環境で何も表示されないことがあるようです。
エラーは表示されないようです。
私が試したサンプルのhtmlファイルでは正常に動作するそうなので、
上のソースの（前略）（中略１）（中略２）（中略３）（後略）に何らかの記述があると結果が真っ白になるのかもしれません。
どのような原因が考えられますでしょうか。私の環境で再現したいです。

ちなみに、次の状態では真っ白になることを確認しています。

1. htmlファイルの文字コードがUTF-8などでSHIFT-JISではない
2. マクロを実行するExcelファイルと同じフォルダーに.htmを含むファイルが一つもない
3. htmlファイルが圧縮フォルダーの中にある。
4. htmlファイルに<!--(商品)-->が無い。

これら以外に真っ白になる原因を探しています。
また次の状態ではエラーになることを確認しています。

1. <!--(商品)-->から<!--(商品)-->までの間に/が３個ない場所がある。

もし、エラーの時にエラーメッセージを表示せずに何もしないことがあるとしたら、
真っ白な結果はエラーが原因と考えられますが、
もしもそうなら、Excelの設定でエラーメッセージを表示させない方法を教えてください。
VBAの記述でエラーをスキップさせることはできるようですが、
そうではなくて、Excelの設定で表示させない方法です。

問題の起こったマクロは次の通りです。
（On Errorステートメントを使った対処は、今後追加する予定です）

Sub sample()
Dim folder As String
Dim r As Long
Dim n As Long
Dim m As Long
Dim item(30000) As Variant '商品数以上に設定
Dim itemname(30000) As Variant '商品数以上に設定
Dim price(30000) As Variant '商品数以上に設定
Dim file(10000) As Variant 'ファイル数以上に設定
Dim str As Variant
Dim str0 As String
Dim buf As String
Dim cnt As Long 'ファイル数

folder = ThisWorkbook.Path '全てがあるフォルダ
r = 0

cnt = 0
buf = Dir(folder & "\*.htm*") '拡張子にhtmを含むファイルを一つ見つける

Do While buf <> ""
cnt = cnt + 1
file(cnt) = buf 'Dirで見つけたファイルを毎回file()に格納する
Range("H" & cnt + 1).Value = file(cnt) 'ファイル一覧の表示
buf = Dir() '上のDirと同じことを毎回繰り返すが、一度見つけたファイルは除外するらしい
Loop

For n = 1 To cnt 'ファイル数だけしか実行しない

With CreateObject("ADODB.Stream")
.Charset = "SHIFT-JIS" 'ファイルの文字コードを指定、UTF-8なら"UTF-8"
.Open
.LoadFromFile (folder & "\" & file(n))
str0 = .ReadText '.ReadTextのままだと問題が起きそうなので、str0にコピーした
.Close
End With

str = Split(str0, "<!--(商品)-->") 'ファイルのテキストを<!--(商品)-->で分割

For m = 1 To UBound(str) 'UBound関数は配列の指定された次元で使用できる添字の最大値を返す

str(m) = Split(str(m), "<!--/.itemPrice-->")(0) '分割した各ファイルの<!--/.itemPrice-->の後ろを切り捨て
item(r + m) = Split(Split(str(m), "/")(3), """")(0) 'コンパクトになった分割テキストから商品番号を抽出
itemname(r + m) = Split(Split(str(m), ">")(1), "<")(0) 'コンパクトになった分割テキストから商品名を抽出
price(r + m) = Split(Split(str(m), "卸価格")(1), "円/点(税抜)")(0) 'コンパクトになった分割テキストから卸価格を抽出

Range("A1").Value = "商品番号"
Range("B1").Value = "商品名"
Range("C1").Value = "卸価格［円/点(税抜)］"
Range("D1").Value = "通し番号"
Range("E1").Value = "ファイル名"
Range("F1").Value = "卸価格チェック"
Range("G1").Value = ""
Range("H1").Value = "ファイル名一覧"
Range("A" & r + m + 1).Value = item(r + m) '商品番号をＡ列に書き込み
Range("B" & r + m + 1).Value = itemname(r + m) '商品名をＢ列に書き込み
Range("C" & r + m + 1).Value = price(r + m) '卸価格をＣ列に書き込み
Range("D" & r + m + 1).Value = r + m '通し番号
Range("E" & r + m + 1).Value = file(n) 'ファイル名をＥ列に書き込み
Range("F" & r + m + 1).Value = "=C" & r + m + 1 & "*0" '卸価格が数値かチェック

Next

r = r + UBound(str) '次のファイルから抽出したデータを前のデータの下に書き込むため

Next
End Sub

質問者からの補足コメント

• 現在は
  Sub sample()
  の直後に
  On Error Resume Next
  を入れてあります。
  これで、
  「1. <!--(商品)-->から<!--(商品)-->までの間に/が３個ない場所がある。」
  場合にもエラーメッセージを表示しなくなりました。
  質問は、On Error Resume Next などエラー対策が記述されて無い状態で、
  エラーメッセージが表示されず、結果が真っ白になるケースについてです。

    補足日時：2015/04/14 23:58

• > また次の状態ではエラーになることを確認しています。
  >
  > 1. <!--(商品)-->から<!--(商品)-->までの間に/が３個ない場所がある。
  
  他にもエラーになる原因として、
  2. <!--(商品)-->から<!--(商品)-->までの間に「>」が一つもない。
  3. <!--(商品)-->から<!--(商品)-->までの間に「卸価格」が一つもない。
  を確認しています。
  だから、
  <!--(商品)-->
  <!--(商品)-->
  <!--(商品)-->
  のように<!--(商品)-->が並んでいるだけの所があるとエラーになることは分かりました。
  
  たぶん、マクロのエラーを表示させない設定があると思うのですが、
  Excelのオプションを探しても見つかりませんでした。
  どこにあるか、教えてください。

    補足日時：2015/04/15 00:27

• WindFallerさんの回答で、
  「str(m) = Split(str(m), "<!--/.itemPrice-->")(0)」が怪しくなってきました。
  str(m)でmの値を文字列に変換しただけなら、<!--/.itemPrice-->が無いだけでなく、
  ほとんど空白のテキストです。データはmの値がテキストになっただけです。
  もしもそうなら、その結果がエラーを出さずに真っ白になっても変ではありません。
  すぐに再現できそうにありませんが、余裕ができたら検討したいと思います。

    補足日時：2015/04/16 18:10

• 「Excelのマクロを実行しても、エラーメッセージもなく結果が真っ白」を実現しました。
  やはり文字コードの問題でした。
  Windows標準のテキストエディタ「メモ帳」でhtmlファイルを作ることにより実現しました。
  私が使っていたテキストエディタでは他の文字コードはSHIFT-JISですが、
  その中に次のような文字があると、真っ白な結果でした。
  ⒶⒷⒸⒹ
  丸Ａ、丸Ｂ、丸Ｃ、丸Ｄなどです。
  ウェブページからこれらの文字を拾ってきてhtmlファイルのコピーし、「メモ帳」で保存しようとするとこれらの文字を残したければUnicodeで保存するように注意されたのでそうしました。
  他のテキストエディタで開くと?で表示されて気付かないです。
  これらの文字があるhtmlで私が作ったマクロを実行すると、結果は、エラーを表示せずに真っ白でした。
  str(m)がどんな文字になっているかは確認できませんでした。

    補足日時：2015/04/17 00:36

• 答えが見つかったと思いますので、この質問を閉じます。
  WindFallerさん、その他、読んでくださった方々、
  ありがとうございました。

    補足日時：2015/04/17 00:39

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2015/04/16 16:28

こんにちは。

しばらく、前回の回答の様子を見させていただきました。
>エラーメッセージが表示されず、結果が真っ白になるケースについてです。
Split で、うまく切り分けられるものか、という不安は感じます。
これについては、正直なところ、よく分かりません。

直接の回答でなくて申し訳ありません。
今回、私も同様の状況下で回答したことがあるので、少し、コメントしたいと思いました。
私の考えていることが分かっていただけるかと思い、コメントしましたが、もしも、私の内容が不愉快でしたら、無視されて結構です。

>私の環境では正常に動作するのですが、他の人の環境で何も表示されないことがあるようです。

それについては、違うと思います。根本的に相手のHTMLデータは違うものなのです。相手は、そのことには触れずに、ただ、回答者側のマクロにエラーが出ると言っているにすぎません。本当にエラーなのか、設定でのミスなのか、またHTMLの内容について、本物はどうなっているのか何も知らされていないのではありませんか？まして、サーバーに置いているならともかく、HDDに入っているものでは、微妙な部分が違っているはずです。

これは、質問者側の良識の問題であって、回答側が考えても解決しないと思います。HTMLコードが完全でなく、こちら側で補正しなければならないようなものは、もう相手の問題について再現性など取れるとは思えません。まして本人は、VBAを知らないのでは話にならないと思います。


なお、コードの中で
str(m) = Split(str(m), "<!--/.itemPrice-->")(0)
このどこかで、Str関数が働いていませんでしょうか？Strを配列変数として用いているつもりでも、どこかで誤動作が発生していないか、少し気になります。Str関数が大きなトラブルを産むわけではありませんが、先頭に空白値が入ってしまいます。

なお、今回のデータについてはマクロを考えてみました。データなどは、前回の掲示板で、いしいさんが公開された２種類のデータ・ファイルを利用させていただきました。

http://oshiete.goo.ne.jp/qa/8960515.html
JISファイルでも、UTF8でも、どちらも可能です。

'//
Option Explicit
Private objRe As Object
Private Ar() As Variant
Sub MacroTest2()
　Dim MyArray() As Variant
　Dim i As Long, j As Long
　Dim FName As String
　Dim MyPath As String
　Dim d As Variant
　Dim rw As Long
　Dim ItmNo
　Dim Data
　Dim buf As String
　Dim dummy As Variant
　Dim FNo As Integer
　Dim TextLine As String
　Set objRe = CreateObject("VBScript.RegExp")
　rw = 2 '書き出しの初期値
　i = 0
　Range("A1").CurrentRegion.ClearContents
　MyPath = ThisWorkbook.Path & "\"
　Range("A1").Resize(, 7).Value = Array("商品番号", "商品名", "卸価格［円/点(税抜)］", "通し番号", "ファイル名", "卸価格チェック", "ファイル名一覧")
　FName = Dir(MyPath & "*.htm?", vbNormal)
　Do While FName <> ""
　　If FName <> "." And FName <> ".." Then
　　　If (GetAttr(MyPath & FName) And vbNormal) = vbNormal Then
　　　　ReDim Preserve MyArray(i)
　　　　MyArray(i) = MyPath & FName
　　　　i = i + 1
　　　End If
　　End If
　　FName = Dir
　Loop
　'On Error Resume Next
　
　For Each d In MyArray
　　FNo = FreeFile()
　　Open d For Input As #FNo
　　Do While Not EOF(FNo)
　　　Line Input #FNo, TextLine
　　　If InStr(1, TextLine, "UTF-", 1) > 0 Then
　　　　UTFtoSJIs d, buf
　　　　Exit Do
　　　Else
　　　　buf = buf & TextLine
　　　End If
　　Loop
　　Close #FNo
　　Call RegPickUp(buf)
　　For j = 0 To UBound(Ar)
　　　buf = Trim(Ar(0)(j))
　　　If buf <> "" Then
　　　　Cells(rw, 1).Resize(, 2).Value = Split(buf, Space(1))
　　　End If
　　　On Error Resume Next
　　　dummy = Ar(1)(j)
　　　If Err() = 0 Then
　　　　Cells(rw, 3).Value = Val(StrConv(Ar(1)(j), vbNarrow))
　　　End If
　　　dummy = Empty
　　　On Error GoTo 0
　　　Cells(rw, 4).Value = rw - 1
　　　Cells(rw, 5).Value = Dir(d)
　　　rw = rw + 1
　　Next j
　Next d
End Sub

Sub RegPickUp(ByVal htmTxt As String)
　Dim Matches
　Dim Match
　Dim myPats As Variant
　Dim Pat As Variant
　Dim i As Long, j As Long
　Dim buf As Variant
　With objRe
　　.Global = True
　　.IgnoreCase = False
　　myPats = Array("/shop/\d+/(\d+)"">([^<完]+)<", "卸価格([\d,０-９?]+)\D*円/点")
　　For Each Pat In myPats
　　　.Pattern = Pat
　　　Set Matches = .Execute(htmTxt)
　　　For Each Match In Matches
　　　　If IsObject(Match.SubMatches) Then
　　　　　For i = 0 To Match.SubMatches.Count - 1
　　　　　　buf = buf & Space(1) & Replace(Match.SubMatches(i), ",", "")
　　　　　Next
　　　　End If
　　　　buf = Trim(buf) & vbTab
　　　Next
　　　ReDim Preserve Ar(j)
　　　Ar(j) = Split(buf, vbTab)
　　　buf = ""
　　　j = j + 1
　　Next
　End With
End Sub

Sub UTFtoSJIs(ByVal FName As String, ByRef strTxt As String)
'http://oshiete.goo.ne.jp/qa/8960515.html の引用
　With CreateObject("ADODB.Stream")
　　　.Charset = "UTF-8"
　　　.Open
　　　.LoadFromFile (FName)
　　　strTxt = .ReadText
　　　.Close
　　End With
End Sub
'///

この回答へのお礼

ありがとうございます。
マクロを作り慣れた人が作ると違うなぁと感じました。(^^;
サブルーチンがあって、エラー対策もしてあって…。
コピーして勉強させていただきます。

今回の件でご心配くださりありがとうございます。
今回の問いは、質問者の問題解決のためというよりも単なる私の好奇心なのです。
先の方の質問者はテキストファイルを繋げてからJavascriptを使うという、
「なるほど」と思う方法で手間を省いたみたいなので感心しています。
私がその発想を思いつかなかったのが悔しいです。
的外れな回答だったはずのJavascriptが役立って良かったです。
Javascriptを使うならブックマークレットを作った方が良かった気もしますが…。

VBAの方は、試しに作ったらできちゃったので、
誰かが回答していれば私は回答しなかったのですが、
一つの回答を持っているのに回答しないのは申し訳ない気がして、
Javascriptを使った手間のかかる方法を回答をしてしまった申し訳なさもあり、
つい回答しちゃいました。
エラー対策もしてない雑なマクロで質問者に付き合わせちゃって申し訳なかったです。
これ以上私の好奇心に付き合ってもらうのは申し訳なかったので質問を締めてもらいました。

その代り、気になることが残ったので、私の質問として「教えて！goo」に投稿しました。
投稿後、私のマクロではエラーが多発しそうなことが分かりました。
テンプレートを使って表示するテキスト部分だけを変えたhtmlファイルって、
無駄な部分を残したままのことが多いでしょうから。
私のマクロは自分用には良いのですが、
身近にいない他人に提供するようなものではありませんでした。反省してます。

エラー無しに真っ白になる原因は、
私が経験したのは質問に書いたくらいなので、
他に経験者がいれば教えてほしいと思いました。

エラーが起こってもエラーメッセージを出さずに無視する設定は、
ありそうなので、知っている人がいれば教えてほしいと思いました。
エラーメッセージを出さずに、全てのマクロを無視する設定はあるようですが…。

長くなりましたが、そんな事情です。
今は先の質問者の問題ではなく、私の問題になっています。

Str関数の件、マクロを書く前にちゃんと確認してませんでした。勉強します。
ありがとうございました。

お礼日時：2015/04/16 17:59