KMLファイルをVBAでCSVファイルに変換する

KMLファイルをVBAで読み込む

「MSXML2.DOMDocument」を使用して、VBAでKMLファイルを読み込む方法の備忘録です。

waq3-travelog.com

2024.01.15

前回、VBAによるKMLファイルの読み込みを記事にしました。

今回は、読み込んだKMLファイルのデータを用いてCSVファイルへ変換するコードを紹介します。

KML→CSV変換コード

Sub Convert_KML_To_CSV()

'KMLファイルをcsvファイルに変換する

Dim strTgTfldNM As String 'ターゲットフォルダを格納する
Dim strTgTfleNM As String 'ターゲットファイルを格納する

'アクセスのあるフォルダのパスを取得
strTgTfldNM = Application.CurrentProject.Path

'読み込むKMLファイル名を設定
strTgTfleNM = "須磨駅から神戸須磨シーワールドまでのルート.kml"

Dim Objkml As Object 'xml操作用オブジェクト

'要素格納用変数
Dim youso_LineString As Object
Dim youso_coordinates As Object

'CSVファイル出力用のデータを格納する変数
Dim strCSV As String

Dim obj_AdoSt As Object 'ADOファイルストリームを使用してテキストを出力する

'変数をリセット
strCSV = ""

Set Objkml = CreateObject("MSXML2.DOMDocument")

    With Objkml
    
        'KMLファイル読み込み
        .Load strTgTfldNM & "\" & strTgTfleNM
        
        Set youso_LineString = .getElementsByTagName("LineString").Item(0)
        
        For Each youso_coordinates In youso_LineString.getElementsByTagName("coordinates")
            
            'CSVファイル出力用の変数に格納
            strCSV = strCSV & Replace(youso_coordinates.Text, " ", "")
        
        Next youso_coordinates
    
    End With

'CSVファイル出力
strTgTfldNM = CurrentProject.Path  '出力先はこのAccessファイルのあるフォルダ
strTgTfleNM = "waq3.CSV"

'ターゲットフォルダ内のCSVファイルの有無をチェック
If Dir(strTgTfldNM & "\" & strTgTfleNM) <> "" Then

    MsgBox "同名のファイルがあります", vbCritical
    
    '出力先のフォルダを開く
    Application.FollowHyperlink strTgTfldNM
    Exit Sub
End If


'CSVファイル出力

'上書きモードでファイルをオープン
Set obj_AdoSt = CreateObject("ADODB.Stream")

' 文字コードを指定（UTF-8で出力）
obj_AdoSt.Charset = "UTF-8"

' 改行コードを指定（-1はCRLF）
obj_AdoSt.LineSeparator = -1

' オープン
obj_AdoSt.Open

obj_AdoSt.WriteText strCSV, 1

'CSVファイルの保存
obj_AdoSt.SaveToFile strTgTfldNM & "\" & strTgTfleNM, 2
obj_AdoSt.Close

MsgBox "処理終了", vbInformation

End Sub

上記のVBAコードを実行すると、アクセスが置いてあるフォルダ内に「waq3.CSV」というCSVファイルを作成します。