補足説明に記載したかったのですが、文字数制限の為、こちらに記載致しました。全文ではございませんが、やり方が判れば、こちらで多少加工は出来そうですので、これがソースの全文と仮定してご回答頂ければ幸いです。
"
<h2 class=""dlpo-1-1"">商品紹介</h2><!-- ←DLPO -->
<div id=""catchComment"">
<div class=""inner"">
<h3><!--キャッチコピー-->履くダイエットの大定番!<!--/キャッチコピー--></h3>
<p>
<!--商品コメント-->商品詳細:<br>履くダイエットの大定番!<br>段階式着圧設計でほっそり美脚をサポート。<br>お肌の透け感がある25デニールのゾッキパンスト。<br>つま先補強タイプ。<br>商品サイズ:105×135×30(mm)<br>ケース入数:240<!--/商品コメント--></p>
</div>
</div>
<tr class=""firstRow"">
<th>商品管理番号</th>
<td>4545633002374</td>
</tr>
<tr>
<th>ブランド名</th>
<td>あいうえお株式会社
</td>
<!-- <td>あいうえお株式会社()</td> -->
</tr>
<tr>
<th>サイズ・容量</th>
<td>1足</td>
</tr>
<tr>
<th>規格</th>
<td>原産国:日本</td>
</tr>
<tr>
<th>注意事項</th>
<td>商品パッケージ画像やアテンションシール、キャッチコピー・文言は予告なく変わることがあります。<br> <img src=""../../../image.space.rakuten.co.jp/d/strg/ctrl/6/9f5a7f69a4120a16a709e75ac20dd03af1d6776c.04.1.6.2.jpg""></td>
</tr>
<tr>
<th>出荷条件</th>
<td>1~5営業日程度での出荷予定(最短翌日出荷。在庫不足の場合、メーカー様より仕入後の納品となります。)</td>
</tr>
<tr>
<th>注文について</th>
<td>
取引申請が必要です
</td>
</tr>
<tr>
<th>良品返品</th>
<td>
不可
</td>
</tr>
<tr>
<th> 支払条件<br>
販売条件<br>
返品条件</th>
<td><a href=""#torihikijyouken"">こちらをご覧ください</a><br>
出展企業毎に異なりますので、必ずご確認ください</td>
</tr>
<tr>
<th>登録/更新</th>
<td>2015/04/02</td>
</tr>
</table>
</div>
</div>
</div> <!-- /itemInfo -->
</td>
</tr>
</table> <!-- id=""layoutTable2"" -->
<div class=""contEnd"">
<hr>
</div>
</div> <!-- /itemInfo1 -->
<div class=""dlpo-6-5_2""></div><!-- ←DLPO -->
<!---->
<div id=""itemInfo2"" class=""line2"">
<!---->
<div id=""cartTable"">
<p class=""align_right"">かきくけこは内税ですが他の卸提示価格との比較のために、外税の参考額として表示しております。</p>
<div class=""inner"">
<div class=""inner1"">
<div class=""inner2"">
<table border=""0"" cellspacing=""0"" summary=""トレイン カロリー237着圧PS BKの商品明細情報"">
<tr id=""headRow"">
<th class=""col1"">注文欄<br>
番号</th>
<th class=""col2"">商品管理<br>
番号</th>
<th class=""col3"">内訳</th>
<th class=""col4"">
メーカ希望小売価格
</th>
<th class=""col5"">
卸価格<!----></th>
<th class=""col6"">セット毎数量
</th>
<th class=""col7"">ご注文セット数</th>
</tr>
<tr class=""odd"">
<td class=""setId""> 1
<input type=""hidden"" name=""set_id_1"" value=""1""></td>
<td>4545633002374</td>
<td>カロリー237着圧PSBK</td>
<td>
800円/点(税込)
</td>
<td>
</td>
<td>
<div align=""right"">
<!---->
1点
</div>
</td>
<td>
<input type=""hidden"" name=""set_num_1"" value=""1"">
<!---->
<!---->
卸価格閲覧・ご注文には<br>
会員登録(ログイン)が必要です<br>
<div class=""reg_login_btn""> <a href=""https://www.aaaaaa.jp/regist/index.html_registTr …仕入れ会員登録</span></a> </div>
<div class=""reg_login_btn""> <a href=""../../dap/sv/Login_.html""><span>ログイン</span></a> </div>
</td>
</tr>
<tr class=""even"">
<td class=""setId""> 2
<input type=""hidden"" name=""set_id_2"" value=""2""></td>
<td>4545633002374</td>
<td>カロリー237着圧PSBK ×240点セット</td>
<td>
800円/点(税込)
</td>
<td>
<!---->
<!---->
</div> <!-- class=""inner2"" -->
</div> <!-- class=""inner1"" -->
</div> <!-- class=""inner"" -->
</div> <!-- id=""cartTable"" -->
<div id=""orgPhoto"">
<img src=""../../../img04.aaaaaa.jp/ex36/sign_image/6/357136/S357136.jpeg"" alt=""あいうえお株式会社"">
<br>
<input type=""hidden"" name=""imageCopyOk"" id=""imageCopyOk"" value=""0"">
<!-- 商品詳細画像 -->
<div style="" height:1px; width:1px; overflow:hidden;"">
<img src=""../../../img03.aaaaaa.jp/ex34/20141120/7/6436467_0.jpg"" alt="""" class=""imageborder"" name=""photoName1"" id=""photoName1"" onClick=""overSizeLink('photoName1')""><br> </div>
<!-- /商品詳細画像 -->
No.1
- 回答日時:
こんにちは。
いろいろ振り回させてすみませんです。
回答の軸をこちらにさせていただきます。
このソースは、まず、調整しなおさないといけませんね。
本当は、どこかの臨時のダウンロードサイトやフリーサイトで、ソースの固有情報だけを抜いて、それを置いていただければと思っていました。ここのサイトが改編になる前は、そういう方が時々いらっしゃいました。個人のプライバシーが守られればよいので、それでも、お咎めありませんでした。
ここのサイトの規約は表向きはあまり変わらないようでも、内部的な運営側の対応が、民間と地方公共団体の違いぐらいにかなり変わったようで、それをあえてお勧めするというわけにもいきません。今のソース・ファイルですと、だいたい、3分の1程度です。これでできるのかな、という不安は感じています。
私が考えているベストの方法は、
http://oshiete.goo.ne.jp/qa/8954389.html
と同じように考えてます。まあ、そちらの回答自体は、うまくいっていないのは、やはり半端な数ではないということと、当たり前のお約束のエラー処理を徹底していないからです。手抜きでもなかったのですが、勢いで作ったので、不備があるわけです。逆に質問者さんに問題を出してしまったというようなスタイルになっています。
実際は、このスレの添付画像のように、HTMLファイル(オブジェクト)にして探すという方法を考えています。しかし、そのクラス名が、ファイル自体で、それぞれ変わるのでしょうか?そうすると、タグで探していくのか、それでもうまくないと、前回書いた文字と文字の間の検索方法になるかと思います。ただ、そのスピードが遅いのです。とりあえず、試しにやってみようと思っています。ただし、必ずできるというような、期待はしないほうがよいです。
ご回答ありがとうございます。
何度も読み返しましたが、残念ながら、さっぱり分かりません。似た例もご提示いただきましたので、そちらも何度も読みましたが、似ているようにも全くみえず、理解できませんでした。
プログラムの知識は、ほとんど無い為、そういう事をするマクロは、これです、という回答を求めています。私が得たい結果は、お分かりだと思います。手段は最悪とのご指摘ですので、手段は問いませんので、希望している結果を得られるマクロをご提示いただければありがたいです。
宜しくお願い致します。
No.2
- 回答日時:
こんにちは。
昨日、レスを書きかけていたのですが、もう少しまとめたほうがよいと思いました。
ほぼ、バグ潰しも終わり、全体は出来上がったものの、
>【A1~E1】1行目は取り込みデータではなく、文字列です。
>セルA1:商品番号、B1:商品名、C1:キャッチコピー、D1:商品説明文、E1:商品画像
>【A2~E2】
>dbr02.htmlから抜き出した「商品番号」「商品名」「キャッチコピー」「商品説明文」「商品画像」をそれぞ>れ、A2、B2、C2、D2、E2へ取り込む
前回もお書きしたことですが、まったく同じフォーマット(書式)で出来上がっているのでしょうか?
どうも、そうではないような気がするのです。それを言っても、現場にいるのではないので、しょうがないのかもしれませんが。場合によっては、商品名の中にほとんど入ってしまうこともありえます。
//
<h3><!--キャッチコピー-->履くダイエットの大定番!<!--/キャッチコピー--></h3>
<p>
<!--商品コメント-->商品詳細:<br>履くダイエットの大定番!<br>段階式着圧設計でほっそり美脚をサポート。<br>お肌の透け感がある25デニールのゾッキパンスト。<br>つま先補強タイプ。<br>商品サイズ:105×135×30(mm)<br>ケース入数:240<!--/商品コメント--></p>
//
かならず、こうなら問題はないのです。各社各様で、いろんなスタイルがあるのではないでしょうか。
htmlのソースの取り方がお分かりになるようなので、「<!--キャッチコピー-->」「<!--商品コメント-->商品詳細」の部分は、確認していただけませんか?
ただし、一番最初の部分が取れない時には、現在は、そのファイルは弾くようにしています。
それとも、もう一つ問題は、根本的なことですが、htmlファイルのスタイルなのです。
問題のhtmlファイルは、フォルダとファイルと二重になっていますか?画像データは、フォルダ側に入っています。画面に貼り付ける時は、サムネイルを使い、サムネイルの中にハイパーリンクを埋め込むことにしました。
「希望している結果を得られるマクロ」となるのか、私にも分からないのです。
期待していたにも関わらず、そうではなかった、ということが、ないとは言い切れませんから。
画像の分類は、以前にかかれていた内容を使いました。画像の上は、エクセルのシートで、下は、フォルダーの中身です。下のフォルダーから画像を探します。
No.3
- 回答日時:
こんばんは。
>キャッチコピーがある場合は、必ず><!--キャッチコピー-->商品名<!--/キャッチコピー-->となっているものとしてください。
あくまでもプログラムでの、割り振りなので、コードにキャッチコピーとして書かれていれば、そこに入るというだけで、いろいろなパターンのチェックしているわけではありませんし、人間が判断するようにはできません。結果的には、後でリストにしたがって、フィードバックをしていただかないといけなくこともあるように思います。
>例)45879102.html,45re.html,re_456.htmlという3ファイルがあったとします。
>A1:商品番号 A2:45879102 A3:45re A4:re_456
>B1:ファイル中身 B2:45879102.htmlの全文 B3:45re.htmlの全文 >C3:re_456.htmlの全文
>という風に出来るマクロかツールが欲しいです。
今のところ、VBカテゴリで書かれていた質問(#8955252)にそっていますが、そののちに質問が出た、「全文」という言葉で、何が「全文」なのか、よく分っていません。
キャッチコピーや商品説明やら、表現方法はいろいろあるようです。
確かに、コードをみると、<div id=""catchComment""> という、idがありますから、それはひとつだというのは分かります。
また、例えば、この質問にある内容は、
「1~5営業日程度での出荷予定(最短翌日出荷。在庫不足の場合、メーカー様より仕入後の納品となります。」
<tr class=""firstRow"">
というところにありますが、これらはどうするのでしょうか?
======================================
★もう少し、いくかのパターンの具体的な例があるとよいのですが。
=======================================
>最初に存在しなければ弾く設定ではなく、存在する部分だけを抽出する用、お願い致します。
誤解をされていると思いますが、これはオブジェクトとしては、エラーのことです。ですから、エラーファイルとすることは可能ですが、深追いはしないほうが良いと思います。様々なトラブルの元になる可能性があります。
「画像につきましては、ハイパーリンクは、無い方がありがたいです。その記載を画像をダウンロードするソフトに貼り付けてダウンロードする予定です。ただ、1画像では無く、画像数は最少1~最大10のランダムだと判明しました。」
それで、どうしたらよいのですか?
ものによっては、アドレス10数個×2(画像とサムネイル)を書き出すのでしょうか?そこまでになってしまうと、列の右方向を使うことになるか、ひとつのセルに入れるには、カンマ切りにするか、どちらかです。私としては、ファイルのアドレスを残したほうがよいので、カンマ切りで一つのセルに入れたほうがよいとは思います。補足に出されたコードは、たぶん、その上の大元の部分があるようです。
一応、完成形までは、コードをアップロードしますが、メインテナンス・フリーなら良いのですが、とても、ご期待にそえる内容とは言えないように思えてきました。ご質問者さん自身が、コードを読めればメインテナンスも楽なのですが、VBAでも特殊な分野で、私も最近手探りで覚えただけなのです。
この先、ご質問者さんの業務に関わることでもあり、正直なところ、お金を払って、専門業者さんにお任せになったほうがよいような気がします。
No.4
- 回答日時:
こんにちは。
#3で書いた内容は、ほとんど意味が伝わっていなかったようです。
>><tr class=""firstRow"">はどうするのでしょうか?
これは、[商品管理番号][ブランド名][サイズ・容量][規格]などが含まれている項目のことを指しています。おそらく必要だと解釈しますが、ただ、サンプルhtmlコードは、事実上、ひとつしかありませんので……
>全文抽出のマクロも希望しました。
とありましたから、全文抽出(文字だけ)のプログラムを、保険として、以下に出しておきます。
VBEditor の参照設定が必要です。(画像参照)
'//
'[ツール]参照設定 Microsoft HTML Object Library
Dim oHtml As HTMLDocument
Dim cnt As Long
Dim FName As String
Const sPATH As String = "C:\Temp\" 'HTMLのフォルダー
Sub PickUpData()
Dim FNo As Integer
Dim TextLine As String
Dim i As Long, j As Long
Dim FileNames As Variant
Dim htmlLog As String
Dim fn As Variant
Set oHtml = New HTMLDocument
cnt = 2 '書き出し行の初期値
ReDim FileNames(5000) ファイル数は、5001まで処理をします。
Range("A1").Value = "全文抜き出し"
FName = Dir(sPATH & "*.htm?", vbNormal)
Do While FName <> ""
If FName <> "." And FName <> ".." Then
If (GetAttr(sPATH & FName) And vbNormal) = vbNormal Then
FileNames(i) = sPATH & FName
i = i + 1
If i > 5000 Then Exit Do
End If
End If
FName = Dir
Loop
ReDim Preserve FileNames(i - 1)
For Each fn In FileNames
FName = fn
FNo = FreeFile()
Open fn For Input As #FNo
Do While Not EOF(FNo)
Line Input #FNo, TextLine
If htmlLog = "" Then
htmlLog = TextLine
Else
htmlLog = htmlLog & TextLine
End If
Loop
Close #FNo
'※ここでプログラムが分岐
Call OutPutInnerText(htmlLog)
htmlLog = ""
Next fn
MsgBox cnt - 2 & "個の処理終了!"
End Sub
Sub OutPutInnerText(htmlLog As String)
'文字情報抜き出しプログラム
Dim buf As String
oHtml.body.innerHTML = htmlLog
buf = oHtml.body.innerText
buf = Replace(buf, vbCrLf, vbLf)
Application.ScreenUpdating = False
With Cells(cnt, 1)
.WrapText = True
.VerticalAlignment = xlTop
.EntireRow.AutoFit
.Value = buf
End With
Application.ScreenUpdating = True
cnt = cnt + 1
End Sub
'//
'参照設定の仕方 VBEdiotr より、ツール-参照設定 Microsoft HTML Object Libraryにチェック
No.5
- 回答日時:
>一度htmlファイルを読み込んで、問題なく動作した物を、掲載いただけると助かります
確かに、コメントは、後からの書き入れでしたから、「'」忘れたとしても、一度もRunをしたことがないようなものを、ここに挙げるようなことは、私は、絶対にしませんよ。掲示板の回答者として、私のポリシーとしても、そのようなことはいたしません。
おそらく、実際のファイルをロード(読み込み)していないのだと思います。
慣れている方なら、ローカルウィンドウを使って調べられるのですが。
Const sPATH As String = "C:\Temp\" 'HTMLのフォルダー
コードの上部にあるその部分を、該当ファイルのある実際のご自分のフォルダに変えましたか?
この部分は、ユーザー設定です。ご自身で任意の場所を設定していただくしかありません。
また、拡張子は、html または、htm のみです。それ以外は読みません。
正しい設定、正しい条件になっていなければ、そのようなエラーが発生しないはずです。
一応、これは予備的なコードですから、動かせれば、それでいいとは思いますが、まったく動かないというと、この先の話が進まなくなってしまいます。
No.6
- 回答日時:
>Const sPATH As String = "C:\Users\aaa\Desktop\item" 'HTMLのフォルダー
ここは、
Const sPATH As String = "C:\Users\aaa\Desktop\item\" '←
末尾に「¥」(半角)を入れてください。
通常は、ここらは注意を書いていますが、急遽アップロードした関係で、今回は書いていません。すみませんです。
以下のようにすれば、間違いがあれば、警告します。
次回のコードには、すでに、入れられていますが、こうなっています。
'//
If i = 0 Then MsgBox "ファイルがありません。", vbExclamation: Exit Sub
ReDim Preserve FileNames(i - 1)
'//
解説:
ここを読んでいる回答者の中で、「不要だ」とか、「不幸になる」とか、変な文句を付けてくるマナー違反の人のために書くと、
本来
ReDim Preserve FileNames(i - 1)
これは、不要なのですが、その上の行の
If i > 5000 Then Exit Sub
と連動していて、1000ファイルだけをシートに入れたいという時に、使うように出来ているのです。つまり、5000件も、一つのシートでは読みきれないという場合を考えてのことなのです。そのための措置なのです。だから、予め、ファイル名を取得してしまって、それから、処理をするように出来ています。
No.7
- 回答日時:
解説は、次のスレにて
'//
'Option Explicit 'ブロックを外しても、エラーは発生しないはずです。
'[ツール]参照設定 Microsoft HTML Object Library
Dim oHtml As HTMLDocument
Dim cnt As Long
Dim FName As String
Public Const sPATH As String = "C:\Users\aaa\Desktop\item" '※ユーザー設定
'HTMLファイルのフォルダー(末尾には\を入れる)
Sub PickUpData()
Dim FNo As Integer
Dim TextLine As String
Dim i As Long, j As Long
Dim FileNames As Variant
Dim htmlLog As String
On Error GoTo ErrHandler
Set oHtml = New HTMLDocument
cnt = 2 '書き出し行の初期値
ReDim FileNames(5000)
With Range("A1").Resize(, 6)
.Value = Array("商品番号", "商品名", "キャッチ", "商品説明文", "商品画像", "ファイル名")
.HorizontalAlignment = xlCenter
End With
FName = Dir(sPATH & "*.htm?", vbNormal)
Do While FName <> ""
If FName <> "." And FName <> ".." Then
If (GetAttr(sPATH & FName) And vbNormal) = vbNormal Then
FileNames(i) = sPATH & FName
i = i + 1
If i > 5000 Then Exit Sub '5000件まで
End If
End If
FName = Dir
Loop
If i = 0 Then MsgBox "ファイルがありません。", vbExclamation: Exit Sub
ReDim Preserve FileNames(i - 1)
For j = 0 To UBound(FileNames) '初期値0 ~上限まで
'For j =999 To 1999 '1000件目から、2000件目まで。
FName = FileNames(j) '出力用
FNo = FreeFile()
Open FName For Input As #FNo
Do While Not EOF(FNo)
Line Input #FNo, TextLine
If htmlLog = "" Then
htmlLog = TextLine
Else
htmlLog = htmlLog & TextLine
End If
Loop
Close #FNo
GetInfo htmlLog
htmlLog = ""
Next j
MsgBox cnt - 2 & "個の処理終了!"
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
'---------------------------------
Sub GetInfo(ByVal htmlLog As String)
Dim bsFn As String
Dim i As Long, j As Long, k As Long
Dim i_tb, i_tb_tr, tr_a, itm_nm
Dim ca_com, detail As String
Dim img, img_n1, img_src, img_ea, c_0, do_img
Dim img_n2, img_src0 As String, e As String
Dim tmp As Variant, imges As String
Dim pic_0 As String, ph_prv
Application.ScreenUpdating = False
'この処理の間だけ画面のちらつきを止める
oHtml.body.innerHTML = htmlLog
bsFn = FName '元のファイル名を記録しておく
On Error Resume Next 'エラートラップ
With oHtml
Dim ar(1 To 5) '臨時の配列
Set i_tb = .getElementById("itemTable")
If i_tb Is Nothing Then Cells(cnt, 6).Value = "err:" & FName: Exit Sub 'エラー
'テーブルがなければ、離脱
Set i_tb_tr = i_tb.getElementsByTagName("tr")
If i_tb_tr.Length > 0 Then
For i = 0 To i_tb_tr.Length
tr_a = i_tb_tr(i).innerText
If i = 0 Then ar(1) = "'" & Replace(tr_a, "商品管理番号", "")
If i > 0 Then
detail = detail & vbCrLf & tr_a
End If
Next
ar(4) = detail
detail = ""
End If
Set itm_nm = .getElementById("itemName")
If Not itm_nm Is Nothing Then
If InStr(1, itm_nm.innerHTML, "itemName", 1) > 0 Then
ar(2) = Trim(itm_nm.innerText) 'アイテムネーム
End If
End If
Set ca_com = .getElementById("catchComment")
If Not ca_com Is Nothing Then
c_0 = Trim(ca_com.innerText)
j = InStr(1, c_0, "商品詳細", 1)
If IsEmpty(ar(4)) Then
ar(4) = Trim(Mid(c_0, j + 5))
Else
ar(4) = Trim(Mid(c_0, j + 5)) & ar(4)
End If
If j <> 0 Then
ar(3) = Trim(Left(c_0, j - 1))
End If
End If
Set ph_prv = .getElementById("photoPreview")
If Not ph_prv Is Nothing Then
Set img_ea = ph_prv.getElementsByTagName("td")
If img_ea.Length > 0 Then
For i = 0 To img_ea.Length - 1
do_img = img_ea(i).innerHTML
j = InStr(1, do_img, "http://")
k = InStr(1, do_img, ".jpg")
If j * k > 0 Then
imges = imges & vbLf & Mid(do_img, j, k + 4 - j)
'半角スペースの代わりにLineFeed を入れる
End If
Next i
If Len(imges) > 5 Then
ar(5) = Mid(Trim(imges), 2) 'イメージデータ・アドレス
End If
End If
End If
Cells(cnt, 6).Value = Dir(FName) 'ファイル出力
'-------書式調整 -------------
Cells(cnt, 1).HorizontalAlignment = xlCenter
Cells(cnt, 4).Resize(, 2).VerticalAlignment = xlTop
With Cells(cnt, 1)
.Resize(, 5).Value = ar()
.EntireRow.AutoFit '行の高さのオートフィット
End With
Erase ar
End With
cnt = cnt + 1
oHtml.body.innerHTML = ""
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
どうもありがとうございます。
こちらが必要そうな事も追加で作成頂きまして、感謝致します。
確認致しましたところ、「商品名」と「商品画像」が一つも抽出されませんでした(その他の列は上手く抽出出来ました)。原因は何が考えられますか。
また、商品画像はサーバーにアップロードする際に、各画像のアドレスを半角スペースで区切った書式にしないとならないのですが、LineFeed?から変換してからアップロードする感じになるのでしょうか。
以上、お手数をお掛け致しますが、宜しくお願い致します。
No.8
- 回答日時:
こんにちは。
添付画像の出力結果で、だいたいの雰囲気が分かるかと思います。このようなマクロになりました。
商品説明文の中は、ほとんどの文章を入れているのですが、最後のほうがセルの中に隠れている可能性もあります。
画像リストは、スペースで区切るのではなく、ラインフィード(LF)で区切られています。そうしないと、隠れて見えなくなることがあります。
念のため、付き合わせ用の確認のために、ファイル名が、F列に出ています。
こちら側に、[Private Sub Worksheet_BeforeDoubleClick....]というものがありますから、それをシートモジュールに貼り付ければ、ハイパーリンクの代わりになって、フォルダーのファイルを、ブラウザで確認することができます。不要なら、取り付ける必要はありません。
なお、前回触れていた、ファイルの数の設定の仕方は、
'''For j =999 To 1999 '1000件目から、2000件目まで。
To ファイル数は、必ず、それ以下にないと、エラーが発生してしまいます。
1500しかなければ、For j =999 To 1499 となります。1を引くのは、格納している配列変数が、0からだからです。
'-------オプション1-------
'// 機能:不要なデータを消去する
Sub ClearUsedCells()
'セル消去
If MsgBox("データを消去してよろしいですか?", vbQuestion + vbOKCancel) = vbOK Then
Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Clear
End If
End Sub
'--------オプション2-------
'//シートモジュールへ(ファイル名をダブルクリツクすると、ファイルが開く)
'//取り付け方は、当該シートのタブを右クリックして、[コードの表示]で開いた所に貼り付ける
'//機能:F列のファイル名をダブルクリックすることで、ブラウザでファイルの内容を確認。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ファイル確認用
Dim fn As String
Cancel = True
If Target.Column <> 6 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Count > 1 Then Exit Sub
If StrConv(Target.Value, vbLowerCase) Like "*.htm*" Then
fn = sPATH & Target.Value
If Dir(fn) <> "" Then
With CreateObject("Wscript.Shell")
.Run """" & fn & """", 3
End With
End If
End If
End Sub
No.9
- 回答日時:
なお、プロシージャ名の「Sub PickUpData()」というのは、#4 と #7は同じ名前ですから、後のほうを、
「Sub PickUpData2()」
としたら、呼び出しに間違いは置きないかもしれません。もともとは、同じもので、分岐も可能なのですが、掲示板の板の関係で、見づらくなってしまいます。
それと、「Private Sub Worksheet_BeforeDoubleClick」以外は、「標準モジュール」という場所に入れてください。
VBEdiotr-挿入-標準モジュールで、画面が作られます。
単独なら、シートモジュールでも可能ですが、
Public Const sPATH As String = "C:\Users\aaa\Desktop\item" '※ユーザー設定
これが、「標準モジュール」にないと、一部、機能がなくなってしまいます。
メインのものが動けば、それはそれでよいかもしれませんが、完全に、期待通りとは言えませんので、ファイルを参照する必要があるのでは、と思ったのです。
No.10
- 回答日時:
こんばんは。
>確認致しましたところ、「商品名」と「商品画像」が一つも抽出されませんでした
>原因は何が考えられますか。
そうおっしゃられも、これ以上は、正しいデータを持っているかどうかも不明な状態では、残念ながらわかりかねます。
当方の間違いだとかいうレベルの問題ではなく、元のデータ自体の確認をしないと分からないです。
「商品名」についてなのですが、それらしきサイトをこちらで探して、その収集したファイルで、その部分はすべて検討して、やり直しました。
HTMLコードの中で、「商品名」としている所は"itemName" という所だけのはずです。
コードの中では、「商品名」と書かれていますから、それが取れないとは思えません。ある程度、VBEdiotrが操れる方でしたら、コードは書けなくても、その部分の情報などを、こちら側にフィードバックできるのでしょうし、お近くに、そういう方がいれば、この問題は、データが取得出来ているか、一目瞭然だと思いますが、それらができないとなると、もうお手上げなのです。
せめて、VBAのデバッグツールやローカルウィンドウを使え、その状況に合わせて教えてくれるレベルにないと、どうしようもありません。(画像参照)
手順だけは書いておきます。
最初に、表示で、[ローカルウィンドウ]を出しておきます。
次に、コードをCtr + F [itemName] で、以下の所まで、カーソルを飛ばします。
Set itm_nm = .getElementById("iItemName")
If Not itm_nm Is Nothing Then 'ここで、枠の所をダブルクリックすると、●が入ります。
後は、実行(Run)をして、そこで止まりますから、その時に、ローカルウィンドウの [itm_nm]の前に、[+]が付いているかどうか確認します。
後は、ファンクションキーF8 で、If Not itm_nm の次の行に入っていくかどうか、見極めます。
もし、大丈夫となれば、再び、実行 [▶]をクリックします。
---------------------
以下のように書き換えても、おそらくは結果は変わらないように思います。
Set itm_nm = .getElementById("itemName")
If Not itm_nm Is Nothing Then
If InStr(1, itm_nm.innerHTML, "商品名", 1) > 0 Then '※元は、itemNameだったものです。
ar(2) = Trim(itm_nm.innerText) 'アイテムネーム
End If
End If
または、If構文を取ってしまうという荒療治もありますが、そのどちらかです。
Set itm_nm = .getElementById("itemName")
If Not itm_nm Is Nothing Then
ar(2) = Trim(itm_nm.innerText) 'アイテムネーム
End If
>商品画像はサーバーにアップロードする際に、各画像のアドレスを半角スペースで区切った書式にしないとならないのですが、LineFeed?から変換してからアップロードする感じになるのでしょうか。
LineFeed というのは、エクセルのセル内の改行コードです。全部をまとめて抜き出すのではなかったら、正規表現が可能なテキストエディタを使い、正規表現モードにして、[\n] ->[" "](カギ括弧は不要)で、置換すれば済みますが、それをしたくないのでしたら、
imges = imges & vbLf & Mid(do_img, j, k + 4 - j)
'半角スペースの代わりにLineFeed を入れる
↓
imges = imges & " " & Mid(do_img, j, k + 4 - j)
と書き換えればすみます。また、エクセルのコマンドの置換でも、検索側に、Alt + J で見えないコードが入りますので、置換側に「" "」(半角スペース)とすれば、置換できます。むしろ、アドレスが出ていません、と言われる可能性があったから、見かけ上、出すようにさせました。書式でこのデータは、セルの一番上方にいくようにしてあります。
私は、質問者さんの未公開の情報に関しては、原則として公開しないようにしておりますが、ただ、現実問題として、これ以上は、無理があるように思われます。掲示板である程度を公開するリスクが憚られるようでしたら、このような質問は成り立たないのです。せっかく出していただいた、質問のHTMLコードも実際、そのままではエラーが発生します。
ここの掲示板で、数件同じような質問があり、私が回答したので、行きがかり上受けました。今まで、「ハローワーク」や「気象データー」「グーグル検索」など、一般公開されたもの以外には手を付けたことがありません。以前、無理して、グーグル短縮を使って、外部から、検索できないようにして、出していただいことがありますが、それでも、運営側にお願いして、それも削除していただいた経験があります。
今回は、ここまで引き伸ばしてしまった、こちらがわの責任はあるものの、おそらくはそうであろうと思われるデータを使い、忖度して、こちらで試しています。しかし、本来は、それは掲示板の範囲を越えた行為であり、また、その対象自体が、こちらの思惑とは違う場所(非公開)ということになれば、開発途中でも終了せざるをえないことだけはご了解ください。
添付画像は、デバッグの方法
どうもご丁寧にありがとうございます。
周りに聞ける人はおりませんので、私が初めて記載頂きましたとおりにやってみましたところ、
商品名の取得は、出来ました。ただ、2行に改行されて、「ビギナー購入可」という余分な記述も抽出してしまいます。欲しいのは、「ディブ オリーブ&アルガンクレンジングオイル」だけです。
<div id="itemName">
<div class="inner">
<h2><!--商品名-->ディブ オリーブ&アルガンクレンジングオイル<!--/商品名--></h2>
<div id="itemNamePay">
ビギナー購入可
<img src="../../image/icon/pay_atobarai.gif" alt="後払い可" class="mr">
画像は、下記となります。画像数は、1~10のランダムです。文字数の関係でphotoName2迄にしました。
<!-- 商品詳細画像 -->
<div style=" height:1px; width:1px; overflow:hidden;">
<img src="http://img01.qqqq.jp/ex11/20150409/1/5339021_0.j … alt="" class="imageborder" name="photoName1" id="photoName1" onClick="overSizeLink('photoName1')"><br> <img src="http://img01.qqqq.jp/ex11/20150409/1/5339021_1.j … alt="" class="imageborder" name="photoName2" id="photoName2" onClick="overSizeLink('photoName2')"><br> </div>
<!-- /商品詳細画像 -->
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Selenium.ChromeDriverの使い方について 7 2022/09/22 06:43
- JavaScript jQueryで同じクラス名のものを別物として扱いたい 1 2022/06/17 14:14
- HTML・CSS 【CSS】:hasで可能? imgを含むtr要素を選択したい 1 2022/11/17 14:36
- PHP htmlで複数の個数入力欄を表示させるには 1 2022/09/20 03:11
- HTML・CSS テーブルタグのセルの幅の一部だけを指定 1 2023/03/12 12:02
- HTML・CSS CSSが効かずどのように指定すれば良いか分からないのでアドバイスお願い致します 2 2023/06/07 12:25
- AJAX JavascriptからPHPへのAjax通信でnullが返ってくる 3 2022/08/03 22:00
- HTML・CSS CSSのホバーエフェクト 1 2023/06/19 06:53
- JavaScript EasyUIのSubGrid(jquery)におけるObjectに入れた連想配列について 1 2022/05/02 11:21
- HTML・CSS FC2カートのテンプレートでの商品表示について 1 2023/03/02 18:05
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
html でのテキスト結合について
-
商品詳細を横並びに表示する方法
-
tableタグとformタグの組み合わせ
-
テーブルの枠線に色が付かない
-
divで囲んだ文字が消える
-
Tableタグで作成した表の縮小
-
td width="180" と固定してるの...
-
td要素内のdiv要素をセンタリン...
-
<img>タグにCSSのclass設定可能?
-
太字にするやり方
-
Firefoxを使ってるのですがズー...
-
商品一覧をtableタグで表示する
-
table タグで3列の表を作ると...
-
style=displayでの表示/非表示...
-
formのinputなどの幅100%指定
-
<TD div id="new">←こういうの...
-
テーブルの一部分のセルだけに...
-
リンクをクリック出来ない。
-
Tableタグ内のspan styleが適応...
-
ブラウザ上でのタブ・シフトタ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
html でのテキスト結合について
-
tableタグとformタグの組み合わせ
-
テーブルの一部分のセルだけに...
-
同じクラス名はつけないほうが...
-
テーブル内のテーブルの高さを...
-
XHTMLに関する質問 順序が逆に...
-
Tableタグ内のspan styleが適応...
-
Tableタグで作成した表の縮小
-
ブラウザによってテーブルのセ...
-
cssで、テーブルのtdの中の文字...
-
td要素内のdiv要素をセンタリン...
-
vbscriptで時計を作りたい
-
formのinputなどの幅100%指定
-
Firefoxを使ってるのですがズー...
-
テーブルの枠線に色が付かない
-
divで囲んだ文字が消える
-
TDタグ内での均等割付の仕方
-
表とリスト(ulとtable)の違い...
-
firefoxで「height: 100%;」と...
-
<img>タグにCSSのclass設定可能?
おすすめ情報
ご回答ありがとうございます。
>各社各様で、いろんなスタイルがあるのではないでしょうか。
確認致しましたところ、別の会社では、キャッチコピーが存在しませんでした。最初に存在しなければ弾く設定ではなく、存在する部分だけを抽出する用、お願い致します。
また、キャッチコピーがある場合は、必ず><!--キャッチコピー-->商品名<!--/キャッチコピー-->となっているものとしてください。現在は、「商品説明」等も必ずそうなっているように思いますが、後日修正が必要となる場合もあり得ますので、その部分にコメントをつけていただけると助かります。
>画像につきましては、ハイパーリンクは、無い方がありがたいです。その記載を画像をダウンロードするソフトに貼り付けてダウンロードする予定です。ただ、1画像では無く、画像数は最少1~最大10のランダムだと判明しました。仕様変更となりまして大変申し訳ございません。
<!-- 商品詳細画像 --><div style=" height:1px; width:1px; overflow:hidden;"><img src="http://img04.a.jp/ex15/201504/9/68_0.jpg" alt="" class="imageborder" name="photoName1" id="photoName1" onClick="overSizeLink('photoName1')"><br><img src="http://img04.a.jp/ex15/201504/9/68_1.jpg" alt="" class="imageborder" name="photoName2" id="photoName2" onClick="overSizeLink('photoName2')"><br></div><!-- /商品詳細画像 -->
>「全文」という言葉で、何が「全文」なのか、よく分っていません。
各htmlファイルの中身全部です。該当箇所のみ抽出するのが難しいようなら、全部丸ごとなら可能かと思いました。マクロの段階で、該当箇所を抽出する事を最初に考えましたが、それは厳しいようならばマクロの段階では各ファイルを丸ごと抽出しておいて、MID関数等で該当箇所を後から抽出出来ないかと思いまして、全文抽出のマクロも希望しました。
>エラーのことです
キャッチコピーが存在しない場合でも、他の部分が存在する場合は抽出しなくてはなりません。キャッチコピーは必ずしも入っているとは限らないので、そういう場合もあります。
><tr class=""firstRow"">はどうするのでしょうか?
不要です
>画像アドレスは、1セルに半角スペース区切りでお願い致します。最大10アドレスです。サムネイルや、画像の取得は不要です。
ありがとうございます。
確認しましたが、エラーがあり、動きませんでした。まず、下記で「'」がなく、コメント扱いになっていなかったので、修正しました。
>ReDim FileNames(5000) ファイル数は、5001まで処理をします。
再度実行しましたが、インデックスが有効範囲にありませんというエラーで動きません。こちらは修正方法が分かりません。
> ReDim Preserve FileNames(i - 1)
ここから先は進めておりませんので、その他は大丈夫なのかは不明です。お手数ですが、一度htmlファイルを読み込んで、問題なく動作した物を、掲載いただけると助かります。
すみません。正しく設定したつもりですが、間違っていたのかもしれないですね。
フルパスを右クリックしてコピぺしましたので、スペルミスはありませんが、どこか間違っていますか。また、拡張子はhtmlのみです。
Dim oHtml As HTMLDocument
Dim cnt As Long
Dim FName As String
Const sPATH As String = "C:\Users\aaa\Desktop\item" 'HTMLのフォルダー
FName = Dir(sPATH & "*.htm?", vbNormal)
~~~~~~~~~~~~~~~
ReDim Preserve FileNames(i - 1) ここでエラーになります。
エラー内容:実行時エラー'g':
インデックスが有効範囲にありません。
photoName1~photoName10迄の名前は、各htmlファイルで1か所しかありません。
getElementById("photoPreview")をgetElementById("photoName1")にするのかも?と思いましたが、うまく行きませんでした。ソースは必要そうな部分を抜き出して、アドレスだけ「qqqq.jp」に変更してありますが、他は一切変更しておりません。必要な個所が不足しているようならば全文もお渡ししたいですが、やり方がわかりません。ここだと文字数オーバーになります。