締切済み

エクセルＶＢＡでフォルダ内にテキストファイルを格納

2014/11/03 19:24

例示の表データからテキスト（ＨＴＭＬ）ファイルを生成し、特定のフォルダヘ格納したい。ファイル名はすべて　index.html　とする。エクセルは2003 フォルダは作成ずみデスクトップ＞zenkoku＞kanagawa＞kanagawa01＞kanagawa01A 分類方法については、・大分類：県ごと・中分類：２０社ごと・小分類：１社ごとテキストＨＴＭＬファイルの作成パターンは２つパターン(1)　中分類のフォルダに格納・「会社名」と「住所」の２つの項目・２０社ごとにファイルを作成・ファイル名は　index.html パターン(2)　小分類のフォルダに格納・「会社名」「住所」「電話番号」の３つの項目・１社ごとにファイルを作成・ファイル名は　index.html

value100100
お礼率78% (44/56)

Visual Basic
回答数8
ありがとう数7

みんなの回答 （8）
専門家の回答

みんなの回答

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/21 23:29 回答No.8

止まった時に、黄色くなってる行の strPath にカーソル乗せたら値が見えますよ。＃５さんの言われるよう、パスのどれかが存在してないハズ画面下側のイミディエイトウインドウ内で Print strPath でもＯＫ同じように、Print i って入力して何行目なのかも確認

質問者

お礼 2022/12/18 01:40

ありがとうございました。

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/19 00:50 回答No.7

＃３補足で、「エラー行が特定できない」とありますが、 ScreenUpdating= Falseなどの画面抑制するようなコードは書いてませんよ？発生するであろうモジュールのmyPath=の行にカーソル置いてF9キー押下してブレーク行として下さい。（赤くなる。解除は再押下）実行したら上記行で止まるから、F8キー押下して下さい。一行ずつ実行します。それでも進めなくなる行に原因があります。飽きたらF5キー押下で一気に実行できますし、止めたいならテープレコーダーと同じで■を押して下さい。

質問者

お礼 2014/11/20 23:47

回答ありがとうございます。Ｆ８キーを押して１行ずつ実行してみました。 ' 出力ファイルを開く Open strPath & "\index.html" For Output As #nFile 上記の箇所で以下のようなエラー表示が出ました。実行時エラー'76'：パスが見つかりません。

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/19 00:34 回答No.6

> デスクトップ＞zenkoku＞kanagawa＞kanagawa01＞kanagawa01A 掘ったフォルダと一致してますか？画像見てたら「列Ｆ［小分類］末尾の英字が全角」じゃあるまいか？

質問者

お礼 2014/11/20 23:41

回答ありがとうございます。見た目は全角に見えますが、半角になっていました。まぎらわしくて申し訳ございません。

akito0417
ベストアンサー率20% (55/266)

2014/11/13 20:07 回答No.5

指定してるパスが違うんじゃないの？指定してるパスを標準出力なりして、コピって、貼付けてそのフォルダにいけますか？行けないからパスが見つからないって言われてるんだろうけど。正しいパスを指定すれば、エラーは解決するはずです。回答のソース及び変えたと言ってるソースみてないですが、良くパスがないと怒られる原因・指定した最後のフォルダは、実際ちゃんとありますか？・ファイルを保存しようとしてるパスが動的にかわってませんか？(変わるのは構わないけど、指定してるパスは実ディレクトリとして存在する必要がある）・ファイルを保存してるつもりが、開こうとしてませんか？こんくらいですかね、思いつくのは

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/05 20:47 回答No.4

Sub HTMLファイル出力改_小分類用() 　Dim myPath As String 　Dim i As Long 　Dim strPath as string　　'HTML出力ファイルのパス　dim nFile as long　　　'ファイルハンドル　dim nCount as long　　　'20社判定　’環境変数からデスクトップフォルダへのパスを定義する　myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\" 　’なんとなくソートする　’フォルダは要件に記載のとおり、正確に作成されていることを期待　Range("A:F").Sort Key1:=Range("E2"), Key2:=Range("F2"), _ 　　　Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom 　nCount = 0 　　For i = 2 To Range("F1").End(xlDown).Row 　　' ブレーク判定１：前行と現在行を比較する　　' 　処理が必要なのは「初回」または「20社単位名が変わる」　　' 　※初回は見出し行≠データ１行目であること　　' 1社の場合　　If nCount = 0 or Range("E" & i - 1).Text & "|" & Range("F" & i - 1).Text <> Range("E" & i ) & "|" & Range("F" & i ).Text Then 　　　　　　'ファイルハンドルの空きを取得　　　nFile = freefile() 　　　'-出力パスの作成--ここから--------------------------------- 　　　’ 1社の場合　　　strPath = myPath & Range("E" & i).Text & "\" & Range("F" & i).Text "\" & Range("G" & i).Text 　　　'-出力パスの作成--ここまで--------------------------------- 　　　' 出力ファイルを開く　　　Open strPath & "\index.html" For Output As #nFile 　　　'-1社共通部分1出力--ここから--------------------------------- 　　　Print #nFile, "<!DOCTYPE html>" & vbNewLine _ 　　　　　& "<html lang=""en"">" & vbNewLine _ 　　　　　& "<body>" & vbNewLine _ 　　　　　& "<div class=""span3"" id=""sidebar"">" & vbNewLine 　　　'-1社共通部分1出力--ここまで--------------------------------- 　　　nCount = 0 　　End If 　　'-1社個別部分出力--ここから--------------------------------- 　　Print #nFile, vbNewLine _ 　　　　& "<div class=""widget"">" & vbNewLine _ 　　　　& "<h4 class=""widgetTitle"">" & Range("A" & i) & "</h4>" & vbNewLine _ 　　　　& "<ul><li>" & Range("B" & i) & "</li>" & vbNewLine _ 　　　　& "<li>" & Range("C" & i) & "</li></ul></div>" & vbNewLine 　　'-1社個別部分出力--ここまで--------------------------------- 　　’20社単位の出力件数をインクリメント　　nCount = nCount + 1 　　' ブレーク判定２：現在行と次行を比較する　　' 　処理が必要なのは「次行は20社単位名が変わる」または「先ほどの出力が20社目」　　' 　※データ最終行の次行は空白等であること　　’ 1社の場合　　If Range("E" & i).Text & "|" & Range("F" & i).Text <> Range("E" & i + 1) & "|" & Range("F" & i + 1).Text Then 　　　'-1社共通部分2出力--ここから--------------------------------- 　　　Print #nFile, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>" 　　　' 出力ファイルを閉じる　　　Close #nFile 　　　nCount = 0 　　　'-1社共通部分2出力--ここまで--------------------------------- 　　End If 　Next i End Sub

質問者

お礼 2014/11/11 21:59

「パスが見つかりません」というエラーが出ます。そこで Sub Sample() Dim Path As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("Desktop") & "\zenkoku\" ActiveWorkbook.SaveAs Path & "Sample.xls" Set WSH = Nothing End Sub というものでためしてみると問題なくファイルが作成できたので、大分類用の部分だけを以下のように、すこし変更してみたのですが、それでも「パスが見つかりません」というエラーが出て先に進めずにいます。私の知識では解決できないでいます。 Sub HTMLファイル出力改_大分類用() Dim myPath As String Dim i As Long Dim strPath As String 'HTML出力ファイルのパス Dim nFile As Long 'ファイルハンドル Dim nCount As Long '20社判定 Dim Path As String, WSH As Variant '環境変数からデスクトップフォルダへのパスを定義する Set WSH = CreateObject("WScript.Shell") myPath = WSH.SpecialFolders("Desktop") & "\zenkoku\" ～これより以下は変更せず～

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/05 20:45 回答No.3

Sub HTMLファイル出力改_中分類用() 　Dim myPath As String 　Dim i As Long 　Dim strPath as string　　'HTML出力ファイルのパス　dim nFile as long　　　'ファイルハンドル　dim nCount as long　　　'20社判定　’環境変数からデスクトップフォルダへのパスを定義する　myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\" 　’20社単位で処理できるよう、ソートする　Range("A:F").Sort Key1:=Range("E2"), Key2:=Range("F2"), _ 　　　Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom 　nCount = 0 　　For i = 2 To Range("F1").End(xlDown).Row 　　' ブレーク判定１：前行と現在行を比較する　　' 　処理が必要なのは「初回」または「20社単位名が変わる」　　' 　※初回は見出し行≠データ１行目であること　　' 20社の場合　　If nCount = 0 or Range("E" & i - 1).Text <> Range("E" & i ).Text Then 　　　　　　'ファイルハンドルの空きを取得　　　nFile = freefile() 　　　'-出力パスの作成--ここから--------------------------------- 　　　’20社の場合　　　strPath = myPath & Range("E" & i).Text & "\" & Range("F" & i).Text 　　　'-出力パスの作成--ここまで--------------------------------- 　　　' 出力ファイルを開く　　　Open strPath & "\index.html" For Output As #nFile 　　　'-20社共通部分1出力--ここから--------------------------------- 　　　Print #nFile, "<!DOCTYPE html>" & vbNewLine _ 　　　　　& "<html lang=""en"">" & vbNewLine _ 　　　　　& "<body>" & vbNewLine _ 　　　　　& "<div class=""span3"" id=""sidebar"">" & vbNewLine 　　　'-20社共通部分1出力--ここまで--------------------------------- 　　　nCount = 0 　　End If 　　'-20社個別部分出力--ここから--------------------------------- 　　Print #nFile, vbNewLine _ 　　　　& "<div class=""widget"">" & vbNewLine _ 　　　　& "<h4 class=""widgetTitle"">" & Range("A" & i) & "</h4>" & vbNewLine _ 　　　　& "<ul><li>" & Range("B" & i) & "</li>" & vbNewLine _ 　　　　& "<li>" & Range("C" & i) & "</li></ul></div>" & vbNewLine 　　'-20社個別部分出力--ここまで--------------------------------- 　　’20社単位の出力件数をインクリメント　　nCount = nCount + 1 　　' ブレーク判定２：現在行と次行を比較する　　' 　処理が必要なのは「次行は20社単位名が変わる」または「先ほどの出力が20社目」　　' 　※データ最終行の次行は空白等であること　　' 20社の場合　　If Range("E" & i).Text <> Range("E" & i - 1).Text or nCount = 20 Then 　　　'-20社共通部分2出力--ここから--------------------------------- 　　　Print #nFile, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>" 　　　' 出力ファイルを閉じる　　　Close #nFile 　　　nCount = 0 　　　'-20社共通部分2出力--ここまで--------------------------------- 　　End If 　Next i End Sub

質問者

補足 2014/11/11 22:03

「パスが見つかりません」というエラーが出ます。エラーの場合、通常ですと黄色くなって場所がわかるのですが、表示がでるだけなので、場所を特定することができません。パスのことなので、 ’環境変数からデスクトップフォルダへのパスを定義する　myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\" の箇所なのでしょうか？　もう少し調べてみます。

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/05 20:43 回答No.2

文字数制限に引っかかったので、３分割します。 sub　実行() 　'これを呼び出してください　call Sub HTMLファイル出力改_大分類用　call Sub HTMLファイル出力改_大分類用　call Sub HTMLファイル出力改_小分類用 end sub Sub HTMLファイル出力改_大分類用() 　Dim myPath As String 　Dim i As Long 　Dim strPath as string　　'HTML出力ファイルのパス　dim nFile as long　　　'ファイルハンドル　dim nCount as long　　　'20社判定　’環境変数からデスクトップフォルダへのパスを定義する　myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\" 　’都道府県別に処理できるよう、ソートする　Range("A:F").Sort Key1:=Range("D2"), Key2:=Range("E2"), _ 　　　Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom 　nCount = 0 　　For i = 2 To Range("F1").End(xlDown).Row 　　' ブレーク判定１：前行と現在行を比較する　　' 　処理が必要なのは「都道府県が変わる」　　' 　※初回は見出し行≠データ１行目であること　　If nCount = 0 or Range("D" & i - 1).Text <> Range("D" & i ).Text Then 　　　　　　'ファイルハンドルの空きを取得　　　nFile = freefile() 　　　'-出力パスの作成--ここから--------------------------------- 　　　’20社の場合　　　strPath = myPath & Range("D" & i).Text 　　　'-出力パスの作成--ここまで--------------------------------- 　　　' 出力ファイルを開く　　　Open strPath & "\index.html" For Output As #nFile 　　　'-都道府県別1出力--ここから--------------------------------- 　　　Print #nFile, "<!DOCTYPE html>" & vbNewLine _ 　　　　　& "<html lang=""en"">" & vbNewLine _ 　　　　　& "<body>" & vbNewLine _ 　　　　　& "<div class=""span3"" id=""sidebar"">" & vbNewLine 　　　'-都道府県別1出力--ここまで--------------------------------- 　　　nCount = 0 　　End If 　　'-個別部分出力--ここから--------------------------------- 　　Print #nFile, vbNewLine _ 　　　　& "<div class=""widget"">" & vbNewLine _ 　　　　& "<h4 class=""widgetTitle"">" & Range("A" & i) & "</h4>" & vbNewLine _ 　　　　& "<ul><li>" & Range("B" & i) & "</li>" & vbNewLine _ 　　　　& "<li>" & Range("C" & i) & "</li></ul></div>" & vbNewLine 　　'-個別部分出力--ここまで--------------------------------- 　　’出力件数をインクリメント　尤も意味は無い　　nCount = nCount + 1 　　' ブレーク判定２：現在行と次行を比較する　　' 都道府県別の場合　　If Range("D" & i).Text <> Range("D" & i - 1).Text Then 　　　'-都道府県別2出力--ここから--------------------------------- 　　　Print #nFile, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>" 　　　' 出力ファイルを閉じる　　　Close #nFile 　　　nCount = 0 　　　'-都道府県別2出力--ここまで--------------------------------- 　　End If 　Next i End Sub

bin-chan
ベストアンサー率33% (1403/4213)

2014/11/03 20:49 回答No.1

なるほど。ID変えたのだから仕切直しということですね。例示のデータの6行目～7行目でしか、同一都道府県下の中分類が出てませんよ。条件として「同一都道府県下で、20社を越えて処理が必要となることは無い」が抜けてる。でなければ21社あったら2個目のファイル名はどうする？前問（他人様？）で中分類＋小分類もコメント行で記述したんだが参考にすらなりませんでしたか。列Ｄ（大分類）も判断条件に加えるだけですよ