OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

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

  • 困ってます
  • 質問No.8796473
  • 閲覧数212
  • ありがとう数10
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 75% (21/28)

住所録を分類(大中小の3つ)して、それぞれの名前でファイルを作成しています。

旧)中分類のファイル名で「chu」フォルダ内にHTMLファイルを作成
  小分類のファイル名で「sho」フォルダ内にHTMLファイルを作成

これを以下のように改変したいと思っております。

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

当方まったくの初心者なので、手も足も出ませんでした。
どうかご教授よろしくお願いいたします。

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, "<!DOCTYPE html>" & vbNewLine _
& "<html lang=""en"">" & vbNewLine _
& "<body>" & vbNewLine _
& "<div class=""span3"" id=""sidebar"">" & vbNewLine
End If
Print #1, "<div class=""widget"">" & vbNewLine _
& "<h4 class=""widgetTitle"">" & Range("A" & i).Text & "</h4>" & vbNewLine _
& "<ul><li>" & Range("B" & i).Text & "</li>" & vbNewLine _
& "<li><a href=""/sho/" & Range("I" & i).Text & ".html"">連絡先・地図はこちら</a></li></ul></div>" & vbNewLine
If Range("H" & i).Text <> Range("H" & i + 1).Text Then
Print #1, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>"
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, "<!DOCTYPE html>" & vbNewLine _
& "<html lang=""en"">" & vbNewLine _
& "<body>" & vbNewLine _
& "<div class=""span3"" id=""sidebar"">" & vbNewLine
End If
Print #1, "<div class=""widget"">" & vbNewLine _
& "<h4 class=""widgetTitle"">" & Range("A" & i).Text & "</h4>" & vbNewLine _
& "<ul><li>" & Range("B" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("C" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("D" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("E" & i).Text & "</li></ul></div>" & vbNewLine
If Range("I" & i).Text <> Range("I" & i + 1).Text Then
Print #1, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>"
Close #1
End If
Next
End Sub
通報する
  • 回答数3
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.3
レベル13

ベストアンサー率 75% (647/860)

'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
-PR-
-PR-

その他の回答 (全2件)

  • 回答No.1
レベル13

ベストアンサー率 75% (647/860)

会社名      住所     大分類   中分類   小分類 A病院    北海道札幌市   hokkaido  hokkaido1  hokkaido1A B大学病院  北海道旭川市   hokkaido  hokkaido2  hokkaido2B C大学病院  東京都文京区   tokyo    tokyo1    tokyo1A D市立病院  東京都清瀬市   tokyo    tokyo2   ...続きを読む
会社名      住所     大分類   中分類   小分類
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
というファイルが出来て、会社名、住所などがそれぞれに列記されていましたが、
新しくはどのような名前のファイルと中身になるのかが分かりづらいので、
そのあたりを差し支えない程度に詳しく。
たとえば、地図サイトの住所検索のようなものなのか、そのあたりも含めて。
お礼コメント
oshiete100goo

お礼率 75% (21/28)

ご回答ありがとうございます。説明不足で申し訳ございません。

記載いただいた例のデータの場合

hokkaidoのフォルダを作成してその中に
hokkaido01.html
hokkaido02.html
hokkaido03.html
hokkaido1A.html
hokkaido2B.html
hokkaido3C.html の6つのファイル


tokyoのフォルダを作成してその中に
tokyo1.html
tokyo2.html
tokyo3.html
tokyo1A.html
tokyo2A.html
tokyo3C.html の6つのファイル

を入れるようにしたいと思っています。


いまのVBAでは、予め作成しておいたフォルダに
作成したファイルを格納していくようになっています。

これを住所欄をもとにして
hokkaidoとかaomoriのフォルダを作り、
その中にhokkaido01.htmlとhokkaido1A.htmlのファイルを
入れるようにしたいと思っています。
投稿日時 - 2014-10-24 22:38:32
  • 回答No.2
レベル13

ベストアンサー率 75% (647/860)

>新しくはどのような名前のファイルと中身になるのか の、中身が補足になかったので、単にフォルダと 空のファイルという感じで、回答します。 コードが長いので、説明とコードを分けて 掲載します。 四つのプロシージャを使っています。 testMain、cmdMkDir、cmdMakeChuFile、cmdMakeShoFile です。 testMainを実行します。一つにすると長くなるのと、 ...続きを読む
>新しくはどのような名前のファイルと中身になるのか

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


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


四つのプロシージャを使っています。
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のデータを検索し
小分類ファイルを作成します。
これが、処理の流れの概要です。
このQ&Aのテーマ
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ