みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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

例示の表データからテキスト(HTML)ファイルを生成し、特定のフォルダヘ格納したい。

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

エクセルは2003

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

分類方法については、
・大分類:県ごと
・中分類:20社ごと
・小分類:1社ごと

テキストHTMLファイルの作成パターンは2つ

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

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

投稿日時 - 2014-11-03 19:24:20

QNo.8812750

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

止まった時に、黄色くなってる行の strPath にカーソル乗せたら
値が見えますよ。
#5さんの言われるよう、パスのどれかが存在してないハズ

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

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

投稿日時 - 2014-11-21 23:29:22

ANo.7

#3補足で、「エラー行が特定できない」とありますが、
ScreenUpdating= Falseなどの画面抑制するようなコードは書いてませんよ?

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

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

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

投稿日時 - 2014-11-19 00:50:55

お礼

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

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

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

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

投稿日時 - 2014-11-20 23:47:18

ANo.6

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

投稿日時 - 2014-11-19 00:34:47

お礼

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

投稿日時 - 2014-11-20 23:41:21

ANo.5

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

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

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

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

投稿日時 - 2014-11-13 20:07:16

ANo.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

  ' ブレーク判定1:前行と現在行を比較する
  '  処理が必要なのは「初回」または「20社単位名が変わる」
  '  ※初回は見出し行≠データ1行目であること
  ' 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

  ' ブレーク判定2:現在行と次行を比較する
  '  処理が必要なのは「次行は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-05 20:47:36

お礼

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

そこで

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:53

ANo.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

  ' ブレーク判定1:前行と現在行を比較する
  '  処理が必要なのは「初回」または「20社単位名が変わる」
  '  ※初回は見出し行≠データ1行目であること
  ' 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

  ' ブレーク判定2:現在行と次行を比較する
  '  処理が必要なのは「次行は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-05 20:45:04

補足

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

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

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

投稿日時 - 2014-11-11 22:03:05

ANo.2

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

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

  ' ブレーク判定1:前行と現在行を比較する
  '  処理が必要なのは「都道府県が変わる」
  '  ※初回は見出し行≠データ1行目であること
  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

  ' ブレーク判定2:現在行と次行を比較する
  ' 都道府県別の場合
  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

投稿日時 - 2014-11-05 20:43:55

ANo.1

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

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

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

参考URL:http://okwave.jp/qa/q8806227.html

投稿日時 - 2014-11-03 20:49:41

あなたにオススメの質問