例示の表データからテキスト(HTML)ファイルを生成し、特定のフォルダヘ格納したい。
ファイル名はすべて index.html とする。
エクセルは2003
フォルダは作成ずみ
デスクトップ>zenkoku>kanagawa>kanagawa01>kanagawa01A
分類方法については、
・大分類:県ごと
・中分類:20社ごと
・小分類:1社ごと
テキストHTMLファイルの作成パターンは2つ
パターン(1) 中分類のフォルダに格納
・「会社名」と「住所」の2つの項目
・20社ごとにファイルを作成
・ファイル名は index.html
パターン(2) 小分類のフォルダに格納
・「会社名」「住所」「電話番号」の3つの項目
・1社ごとにファイルを作成
・ファイル名は index.html
A 回答 (8件)
- 最新から表示
- 回答順に表示
No.8
- 回答日時:
止まった時に、黄色くなってる行の strPath にカーソル乗せたら
値が見えますよ。
#5さんの言われるよう、パスのどれかが存在してないハズ
画面下側のイミディエイトウインドウ内で
Print strPath でもOK
同じように、Print i って入力して何行目なのかも確認
No.7
- 回答日時:
#3補足で、「エラー行が特定できない」とありますが、
ScreenUpdating= Falseなどの画面抑制するようなコードは書いてませんよ?
発生するであろうモジュールのmyPath=の行にカーソル置いてF9キー押下して
ブレーク行として下さい。(赤くなる。解除は再押下)
実行したら上記行で止まるから、F8キー押下して下さい。一行ずつ実行します。
それでも進めなくなる行に原因があります。
飽きたらF5キー押下で一気に実行できますし、
止めたいならテープレコーダーと同じで■を押して下さい。
回答ありがとうございます。
F8キーを押して1行ずつ実行してみました。
' 出力ファイルを開く
Open strPath & "\index.html" For Output As #nFile
上記の箇所で以下のようなエラー表示が出ました。
実行時エラー'76':
パスが見つかりません。
No.5
- 回答日時:
指定してるパスが違うんじゃないの?
指定してるパスを標準出力なりして、コピって、貼付けてそのフォルダにいけますか?
行けないからパスが見つからないって言われてるんだろうけど。
正しいパスを指定すれば、エラーは解決するはずです。
回答のソース及び変えたと言ってるソースみてないですが、良くパスがないと怒られる原因
・指定した最後のフォルダは、実際ちゃんとありますか?
・ファイルを保存しようとしてるパスが動的にかわってませんか?(変わるのは構わないけど、指定してるパスは実ディレクトリとして存在する必要がある)
・ファイルを保存してるつもりが、開こうとしてませんか?
こんくらいですかね、思いつくのは
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
' ブレーク判定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
「パスが見つかりません」というエラーが出ます。
そこで
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\"
~これより以下は変更せず~
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
' ブレーク判定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
この回答への補足
「パスが見つかりません」というエラーが出ます。
エラーの場合、通常ですと黄色くなって場所がわかるのですが、
表示がでるだけなので、場所を特定することができません。
パスのことなので、
’環境変数からデスクトップフォルダへのパスを定義する
myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\"
の箇所なのでしょうか? もう少し調べてみます。
No.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
No.1
- 回答日時:
なるほど。
ID変えたのだから仕切直しということですね。例示のデータの6行目~7行目でしか、同一都道府県下の中分類が出てませんよ。
条件として「同一都道府県下で、20社を越えて処理が必要となることは無い」が抜けてる。
でなければ21社あったら2個目のファイル名はどうする?
前問(他人様?)で中分類+小分類もコメント行で記述したんだが
参考にすらなりませんでしたか。
列D(大分類)も判断条件に加えるだけですよ
参考URL:http://oshiete.goo.ne.jp/qa/8806227.html
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存 1 2022/03/25 14:19
- Excel(エクセル) 【VBA】フォルダAにある2つのファイルの内1つを、フォルダBへ。もう1つを、フォルダBへ移動したい 6 2022/07/26 08:51
- Visual Basic(VBA) 顧客ごとに違う点検案内を作成するマクロ 4 2022/09/16 05:34
- Visual Basic(VBA) Excel VBA 同じ名前のフォルダがあれば作成したブックを格納するマクロをつくりたい 2 2023/01/16 16:19
- Visual Basic(VBA) Wordマクロで指定したフォルダ名に保存する方法について 8 2022/12/13 11:35
- Visual Basic(VBA) 指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける 3 2022/09/10 07:55
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) 集めたシートのシート名を変更したい。 下記のコードでサブフォルダにあるファイルのSheet3を集めて 6 2022/08/23 10:38
- フリーソフト テキストファイル内を検索したい 1 2022/06/01 08:33
- ホームページ作成・プログラミング Adobe DreamweaverでのサイトのFTP 2 2023/03/05 11:55
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
CSVファイルの時刻の形式について
-
accessでクエリをExcelにエクス...
-
Acrobat参照設定
-
Thunderbird 受信メールからの...
-
EXCEL VBAでプリントイメージフ...
-
アクセス→エクセルへエクスポー...
-
ACCESS エクスポート ダイアロ...
-
コマンドプロンプトのテキスト...
-
エクセルVBAでフォルダ内に...
-
ファイナルカットで編集した動...
-
Excel で「OLE は現在使用でき...
-
C++.NET 2003 「空のドキュメ...
-
ATTファイルってどうやって開け...
-
C++によるファイル送受信プログ...
-
C#について質問【複数の.datフ...
-
Javaのプロパティファイルの文...
-
テキストファイルの一部分を抽...
-
VB.NET テキストファイルにデー...
-
ファイル更新日取得
-
BASP21のファイルアップロード...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
accessでクエリをExcelにエクス...
-
CSVファイルの時刻の形式について
-
COBOL、項目末尾に空白がある場...
-
コマンドプロンプトのテキスト...
-
Thunderbird 受信メールからの...
-
AccessのレポートからPDFをペー...
-
accessのリポートを、excelに出...
-
COBOL FILLER
-
WshShellから起動したbat(ftp)...
-
Acrobat参照設定
-
ファイナルカットで編集した動...
-
クエリをエクセルファイルへの出力
-
excel vbaでのxml出力がわかり...
-
ショートカットで起動した場合...
-
VBA 参照先で選んだファイルを...
-
iTextでPDFを表示させたら日本...
-
Excel で「OLE は現在使用でき...
-
“ファイルに出力”した印刷ファ...
-
EXCEL VBAでのCSVファイル読み...
-
TransferSpreadsheetでフルパス...
おすすめ情報