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

締切済

質問者：value100100
質問日時：2014/11/03 19:24
回答数：8件

例示の表データからテキスト（ＨＴＭＬ）ファイルを生成し、特定のフォルダヘ格納したい。

ファイル名はすべて　index.html　とする。

エクセルは2003

フォルダは作成ずみ
デスクトップ＞zenkoku＞kanagawa＞kanagawa01＞kanagawa01A

分類方法については、
・大分類：県ごと
・中分類：２０社ごと
・小分類：１社ごと

テキストＨＴＭＬファイルの作成パターンは２つ

パターン(1)　中分類のフォルダに格納
・「会社名」と「住所」の２つの項目
・２０社ごとにファイルを作成
・ファイル名は　index.html

パターン(2)　小分類のフォルダに格納
・「会社名」「住所」「電話番号」の３つの項目
・１社ごとにファイルを作成
・ファイル名は　index.html

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (8件)

最新から表示
回答順に表示

No.8

回答者： bin-chan
回答日時：2014/11/21 23:29

止まった時に、黄色くなってる行の strPath にカーソル乗せたら

値が見えますよ。
＃５さんの言われるよう、パスのどれかが存在してないハズ

画面下側のイミディエイトウインドウ内で
Print strPath でもＯＫ

同じように、Print i って入力して何行目なのかも確認

- 0
- 件

通報する

No.7

回答者： bin-chan
回答日時：2014/11/19 00:50

＃３補足で、「エラー行が特定できない」とありますが、

ScreenUpdating= Falseなどの画面抑制するようなコードは書いてませんよ？

発生するであろうモジュールのmyPath=の行にカーソル置いてF9キー押下して
ブレーク行として下さい。（赤くなる。解除は再押下）

実行したら上記行で止まるから、F8キー押下して下さい。一行ずつ実行します。
それでも進めなくなる行に原因があります。

飽きたらF5キー押下で一気に実行できますし、
止めたいならテープレコーダーと同じで■を押して下さい。

- 0
- 件

通報する

この回答へのお礼

回答ありがとうございます。
Ｆ８キーを押して１行ずつ実行してみました。

' 出力ファイルを開く
Open strPath & "\index.html" For Output As #nFile

上記の箇所で以下のようなエラー表示が出ました。

実行時エラー'76'：
パスが見つかりません。

通報する

お礼日時：2014/11/20 23:47

No.6

回答者： bin-chan
回答日時：2014/11/19 00:34

> デスクトップ＞zenkoku＞kanagawa＞kanagawa01＞kanagawa01A

掘ったフォルダと一致してますか？
画像見てたら「列Ｆ［小分類］末尾の英字が全角」じゃあるまいか？

- 0
- 件

通報する

この回答へのお礼

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

通報する

お礼日時：2014/11/20 23:41

No.5

回答者： akito0417
回答日時：2014/11/13 20:07

指定してるパスが違うんじゃないの？

指定してるパスを標準出力なりして、コピって、貼付けてそのフォルダにいけますか？
行けないからパスが見つからないって言われてるんだろうけど。
正しいパスを指定すれば、エラーは解決するはずです。

回答のソース及び変えたと言ってるソースみてないですが、良くパスがないと怒られる原因
・指定した最後のフォルダは、実際ちゃんとありますか？
・ファイルを保存しようとしてるパスが動的にかわってませんか？(変わるのは構わないけど、指定してるパスは実ディレクトリとして存在する必要がある）
・ファイルを保存してるつもりが、開こうとしてませんか？

こんくらいですかね、思いつくのは

- 0
- 件

通報する

No.4

回答者： bin-chan
回答日時：2014/11/05 20:47

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

- 0
- 件

通報する

この回答へのお礼

「パスが見つかりません」というエラーが出ます。

そこで

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\"

～これより以下は変更せず～

通報する

お礼日時：2014/11/11 21:59

No.3

回答者： bin-chan
回答日時：2014/11/05 20:45

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

この回答への補足

「パスが見つかりません」というエラーが出ます。
エラーの場合、通常ですと黄色くなって場所がわかるのですが、
表示がでるだけなので、場所を特定することができません。
パスのことなので、

’環境変数からデスクトップフォルダへのパスを定義する
　myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\"

の箇所なのでしょうか？　もう少し調べてみます。

補足日時：2014/11/11 22:03

通報する

- 0
- 件

通報する

No.2

回答者： bin-chan
回答日時：2014/11/05 20:43

文字数制限に引っかかったので、３分割します。

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

- 0
- 件

通報する

No.1

回答者： bin-chan
回答日時：2014/11/03 20:49

なるほど。

ID変えたのだから仕切直しということですね。

例示のデータの6行目～7行目でしか、同一都道府県下の中分類が出てませんよ。
条件として「同一都道府県下で、20社を越えて処理が必要となることは無い」が抜けてる。
でなければ21社あったら2個目のファイル名はどうする？

前問（他人様？）で中分類＋小分類もコメント行で記述したんだが
参考にすらなりませんでしたか。
列Ｄ（大分類）も判断条件に加えるだけですよ

参考URL：http://oshiete.goo.ne.jp/qa/8806227.html