エクセルＶＢＡで住所録からテキストファイルを作成

Question

住所録を分類（大中小の３つ）して、それぞれの名前でファイルを作成しています。旧）中分類のファイル名で「chu」フォルダ内にＨＴＭＬファイルを作成　　小分類のファイル名で「sho」フォルダ内にＨＴＭＬファイルを作成これを以下のように改変したいと思っております。新）大分類の名前のフォルダを作成して、　　そのフォルダの中に該当する分だけの「中分類のファイル」を作成　　同じフォルダの中に該当する分だけの「小分類のファイル」を作成当方まったくの初心者なので、手も足も出ませんでした。どうかご教授よろしくお願いいたします。 Sub 中分類HTMLソース() Dim fso As Object 'ファイルシステムオブジェクト Dim strPath As String '削除対象ファイル Set fso = CreateObject("Scripting.FileSystemObject") strPath = Environ("USERPROFILE") & "\Desktop\chu\*.*" fso.DeleteFile strPath, True Set fso = Nothing 'ファイルの削除（読み取り専用の場合も削除） Dim myPath As String Dim i As Long myPath = Environ("USERPROFILE") & "\Desktop\chu\" Range("A:I").Sort Key1:=Range("H2"), Header:=xlYes, MatchCase:=False, _ Orientation:=xlTopToBottom For i = 2 To Range("H1").End(xlDown).Row If Range("H" & i).Text <> Range("H" & i - 1).Text Then Open myPath & Range("H" & i).Text & ".html" For Output As #1 Print #1, "" & vbNewLine _ & "" & vbNewLine _ & "" & vbNewLine _ & "

" & vbNewLine End If Print #1, "

" & vbNewLine _ & "

" & Range("A" & i).Text & "

" & vbNewLine _ & "

" & Range("B" & i).Text & "
連絡先・地図はこちら

" & vbNewLine If Range("H" & i).Text <> Range("H" & i + 1).Text Then Print #1, "

" & vbNewLine & "" & vbNewLine & "" Close #1 End If Next End Sub Sub 小分類HTMLソース() Dim fso As Object 'ファイルシステムオブジェクト Dim strPath As String '削除対象ファイル Set fso = CreateObject("Scripting.FileSystemObject") strPath = Environ("USERPROFILE") & "\Desktop\sho\*.*" fso.DeleteFile strPath, True Set fso = Nothing 'ファイルの削除（読み取り専用の場合も削除） Dim myPath As String Dim i As Long myPath = Environ("USERPROFILE") & "\Desktop\sho\" Range("A:I").Sort Key1:=Range("I2"), Header:=xlYes, MatchCase:=False, _ Orientation:=xlTopToBottom For i = 2 To Range("I1").End(xlDown).Row If Range("I" & i).Text <> Range("I" & i - 1).Text Then Open myPath & Range("I" & i).Text & ".html" For Output As #1 Print #1, "" & vbNewLine _ & "" & vbNewLine _ & "" & vbNewLine _ & "

" & vbNewLine End If Print #1, "

" & vbNewLine _ & "

" & Range("A" & i).Text & "

" & vbNewLine _ & "

" & Range("B" & i).Text & "
" & Range("C" & i).Text & "
" & Range("D" & i).Text & "
" & Range("E" & i).Text & "

" & vbNewLine If Range("I" & i).Text <> Range("I" & i + 1).Text Then Print #1, "

" & vbNewLine & "" & vbNewLine & "" Close #1 End If Next End Sub

piroin654 · Accepted Answer

'ADOのレコードセットを使用

Sub testMain()
　　Dim myCon As New ADODB.Connection
　　Dim FileName As String
　　Dim rs1 As New ADODB.Recordset
　　Dim rs2 As New ADODB.Recordset
　　Dim rs3 As New ADODB.Recordset
　　Dim conStr As String
　　Dim strSQL1 As String
　　Dim strSQL2 As String
　　Dim strSQL3 As String
　　Dim dic1 As Object
　　Dim dic2 As Object
　　Dim buf1 As Variant
　　Dim buf2 As Variant
　　Dim i As Long
　　Dim j As Long
　　Dim fso As Object
　　Dim strPath As String

　　Set dic1 = CreateObject("Scripting.Dictionary")
　　Set dic2 = CreateObject("Scripting.Dictionary")

　　strSQL1 = "SELECT 大分類 FROM [Sheet1$] GROUP BY 大分類"
　　strSQL2 = "SELECT * FROM [Sheet1$]"
　　strSQL3 = "SELECT * FROM [Sheet1$]"
　　'カレントフォルダのパス
　　strPath = ThisWorkbook.Path
　　'接続先のExcelファイル(質問の場合は現在のファイル)
　　FileName = ThisWorkbook.FullName

　　conStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
　　　　　　　"Extended Properties=Excel 8.0;" & _
　　　　　　　"Data Source=" & FileName

　　'接続
　　myCon.Open conStr
　　'レコードセットを開く
　　rs1.Open strSQL1, myCon, adOpenStatic, adLockReadOnly
　　rs2.Open strSQL2, myCon, adOpenStatic, adLockReadOnly
　　rs3.Open strSQL2, myCon, adOpenStatic, adLockReadOnly

　　If rs1.RecordCount > 0 Then
　　　　rs1.MoveFirst
　　　　Do Until rs1.EOF
　　　　　　If Not IsNull(rs1!大分類) Then
　　　　　　　　'フォルダ作成
　　　　　　　　Call cmdMkDir(rs1!大分類)
　　　　　　　　'中分類の取得
　　　　　　　　If rs2.RecordCount > 0 Then
　　　　　　　　　　rs2.MoveFirst
　　　　　　　　　　Do Until rs2.EOF
　　　　　　　　　　　　'大分類と同じ分類の中分類を検索
　　　　　　　　　　　　If rs2!大分類 = rs1!大分類 Then
　　　　　　　　　　　　　　If Not IsNull(rs2!中分類) Then
　　　　　　　　　　　　　　　　buf1 = rs2!中分類
　　　　　　　　　　　　　　　　If Not dic1.exists(buf1) Then
　　　　　　　　　　　　　　　　　　'検索済みの中分類をDictionaryに格納
　　　　　　　　　　　　　　　　　　dic1.Add buf1, buf1
　　　　　　　　　　　　　　　　　　'中分類ファイルの作成
　　　　　　　　　　　　　　　　　　Call cmdMakeChuFile(strPath & "\" & rs1!大分類, buf1)
　　　　　　　　　　　　　　　　　　'小分類の取得
　　　　　　　　　　　　　　　　　　rs3.MoveFirst
　　　　　　　　　　　　　　　　　　Do Until rs3.EOF
　　　　　　　　　　　　　　　　　　'大分類および中分類が同じ小分離の検索
　　　　　　　　　　　　　　　　　　If rs2!大分類 = rs3!大分類 And buf1 = rs3!中分類 Then
　　　　　　　　　　　　　　　　　　　　If Not IsNull(rs3!小分類) Then
　　　　　　　　　　　　　　　　　　　　　　buf2 = rs3!小分類
　　　　　　　　　　　　　　　　　　　　　　If Not dic2.exists(buf2) Then
　　　　　　　　　　　　　　　　　　　　　　　　'検索済みの小分類をDictionaryに格納
　　　　　　　　　　　　　　　　　　　　　　　　dic2.Add buf2, buf2
　　　　　　　　　　　　　　　　　　　　　　　　'小分類ファイルの作成
　　　　　　　　　　　　　　　　　　　　　　　　Call cmdMakeShoFile(strPath & "\" & rs1!大分類, buf2)
　　　　　　　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　　　'変数とDictionaryの初期化
　　　　　　　　　　　　　　　　　　buf2 = ""
　　　　　　　　　　　　　　　　　　dic2.RemoveAll
　　　　　　　　　　　　　　　　　'次のレコードに移動
　　　　　　　　　　　　　　　　　rs3.MoveNext
　　　　　　　　　　　　　　　　　Loop
　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　End If
　　　　　　　　　　'次のレコードに移動
　　　　　　　　　　rs2.MoveNext
　　　　　　　　　　Loop
　　　　　　　　End If
　　　　　　　　'変数とDictionaryの初期化
　　　　　　　　buf1 = ""
　　　　　　　　dic1.RemoveAll
　　　　　　End If
　　　　　　'次のレコードに移動
　　　　　　rs1.MoveNext
　　　　Loop
　　End If
　　'後始末 (オブジェクトの破棄が主)
　　rs1.Close: Set rs1 = Nothing
　　rs2.Close: Set rs2 = Nothing
　　rs3.Close: Set rs3 = Nothing
　　myCon.Close: Set myCon = Nothing
　　Set dic1 = Nothing
　　Set dic2 = Nothing
End Sub

Sub cmdMkDir(ByVal strDir As String)
　　Dim obj As Object
　　Dim strPath As String
　　Dim strFolder As String

　　Set obj = CreateObject("Scripting.FileSystemObject")
　　strPath = ThisWorkbook.Path
　　strFolder = obj.BuildPath(strPath, strDir)
　　obj.CreateFolder strFolder

　　Set obj = Nothing
End Sub

Sub cmdMakeChuFile(ByVal strPath As String, ByVal strFileName As String)
　　Dim strFile As String

　　strFile = strPath & "\" & strFileName & ".html"
　　Open strFile For Output As #1
　　Print #1, "<html>"
　　Print #1, "中分類ファイル" & "-------" & strPath & "-------" & strFileName
　　Print #1, "</html>"
　　Close #1
End Sub

Sub cmdMakeShoFile(ByVal strPath As String, ByVal strFileName As String)
　　Dim strFile As String

　　strFile = strPath & "\" & strFileName & ".html"
　　Open strFile For Output As #1
　　Print #1, "<html>"
　　Print #1, "小分類ファイル" & "-------" & strPath & "-------" & strFileName
　　Print #1, "</html>"
　　Close #1
End Sub

piroin654 · Answer

>新しくはどのような名前のファイルと中身になるのか

の、中身が補足になかったので、単にフォルダと
空のファイルという感じで、回答します。

コードが長いので、説明とコードを分けて
掲載します。

四つのプロシージャを使っています。
testMain、cmdMkDir、cmdMakeChuFile、cmdMakeShoFile
です。

testMainを実行します。一つにすると長くなるのと、
cmdMakeChuFile、cmdMakeShoFile
は、実際にhtmlファイルを作成するプロシージャ
ですので、分離しておいたほうが編集がしやすく
なるのでこのようにしています。
cmdMkDir
は、フォルダ作成のプロシージャで、ここでは
大分類のフォルダを作成するために使用します。

各プロシージャの説明、特にtestMainについては
長くなるので、コードにコメントを入れています。

[説明]　testMainについて。
testMainはADOを使用していますので、コード表でADOに
チェックが入っているか確認してください。参照設定で、
　Microsoft ActiveX Data Objects xx Library
となっています。xxはバージョンによってちがいますが、
2.1のような数字です。

testMainは、ADOとDictionaryを使ってデータをSheetから抜き出して
います。つまり、Sheetのデータの集まりをデータベースの
テーブルに見立ててデータの検索、抽出をしています。
コードはほとんどデータベースの操作をVBAでしているので、
一般的なExcelのコードとは違和感があるかもしれません。
本来ならばDictionaryは使わなくても済むのですが、
ExcelのバージョンやOSなどの使用環境によって使えない
機能があるので、あえてDictionaryを使います。

[説明] cmdMakeChuFile、cmdMakeShoFile について。
この二つは、testMainで検索して抽出した該当するフォルダの
場所とファイル名(この場合は、該当する中分類名)を
受け取って、必要なhtmlファイルを作成するものです。
中分類と小分類のファイルの内容が同じならば、一つ
でもいいのですが、一応わけておきました。
なお、各htmlに表示する内容が不明なので、パスと
ファイル名を表示しておきました。
SheetからのデータはADOを使って能率よく取り出せるのですが、
どのようなデータを表示するのかがわかれば、と思います。
そのあたりはどうでしょう。

[説明] cmdMkDir について。
cmdMkDirはtestMainで名寄せをした大分類の各データを
受け取って大分類のフォルダを作成しています。
必要ならば、中分類のフォルダも各大分類のフォルダ
に作成することもこのプロシージャを使用すれば
できます。

[説明]　testMainの処理の流れ

"SELECT 大分類 FROM [Sheet1$] GROUP BY 大分類"
というSQL文で名寄せした大分類をもとに、フォルダを
作成し、
"SELECT * FROM [Sheet1$]"
というSQL文で取得したSheetのデータを検索し、
同じ大分類をもつ中分類を抽出し、中分類ファイル
を作成し、同じ大分類、中分類をもつ小分類を
"SELECT * FROM [Sheet1$]"
というSQL文で取得したSheetのデータを検索し
小分類ファイルを作成します。
これが、処理の流れの概要です。

piroin654 · Answer

会社名　　　　　　住所　　　　　大分類　　　中分類　　　小分類
A病院　　　　北海道札幌市　　　hokkaido　　hokkaido1　　hokkaido1A
B大学病院　　北海道旭川市　　　hokkaido　　hokkaido2　　hokkaido2B
C大学病院　　東京都文京区　　　tokyo　　　　tokyo1　　　　tokyo1A
D市立病院　　東京都清瀬市　　　tokyo　　　　tokyo2　　　　tokyo2A
E道立病院　　北海道函館市　　　hokkaido　　hokkaido3　　hokkaido3C
F大学病院　　東京都目黒区　　　tokyo　　　　tokyo3　　　　tokyo3C

質問より少しフィールドを省略していますが、
たとえば上記のようなデータがシートにあるとして、
具体的には、どのようなデータが入ったファイルを
作成しようとしているのでしょうか？

＞新）大分類の名前のフォルダを作成して、
＞　　そのフォルダの中に該当する分だけの「中分類のファイル」を作成
＞　　同じフォルダの中に該当する分だけの「小分類のファイル」を作成

大分類のフォルダ以外のファイルの中身が分かりづらいのですが。
VBAの中分類HTMLソース()では、
     Sapporo.html　　Asahikawa.html　　Tokyo.html　　Kiyose.html
というファイルが出来て、会社名、住所などがそれぞれに列記されていましたが、
新しくはどのような名前のファイルと中身になるのかが分かりづらいので、
そのあたりを差し支えない程度に詳しく。
たとえば、地図サイトの住所検索のようなものなのか、そのあたりも含めて。

エクセルＶＢＡで住所録からテキストファイルを作成

'ADOのレコードセットを使用

>新しくはどのような名前のファイルと中身になるのか

会社名 住所 大分類 中分類 小分類

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

会社名　　　　　　住所　　　　　大分類　　　中分類　　　小分類