Word VBAと同じように
https://qiita.com/Q11Q/items/da6679fb751ce5db262d
こちらと同じように、Excelで既存のJsonを修正してあらたなgeojsonファイルを出力させることを目的としています。
geojsonをコピペする
Excelを起動する
メモ帳でgeojsonファイルを開く
すべて選択
Excelに貼り付け
データはすべてA列に入るようです。
そこで、すべてA列に入ったとして、修正等をおこなったあと、以下のコードを実行してあらたなgeojsonファイルを作成するというものです。
Sub ExportGeoJason()
'https://qiita.com/kou_tana77/items/66b14c7649792c9703d8
' For Microsoft Excel
' 現在開いている Excel WorksheetにコピペしたGeoJsonを編集している
' GeoJasonを編集したあとに実行し、新たなGeoJsonファイルを作成する。
' Json形式に整形する機能はない
' 文字コード 65001 改行 vbLF BOMなし UTF-8Nと言われる場合もある。
' 参照設定 VBScript Regular expression 5.5,
' Microsoft Scripting Runtime
' Microsoft ActiveX Data Object 6.1
Const OutPutFolder = "C:¥hoge"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim iRow As Long, iCol As Long, LastRow As Long
Dim sr As New ADODB.Stream
Dim sr2 As New ADODB.Stream
Dim Reg As New RegExp, iM As Long, M As Match, MC As MatchCollection, sBs As SubMatches
Dim FSO As New Scripting.FileSystemObject, oFile As File, oFolder As Folder, TS As TextStream
Dim buf As String, arB() As Byte, sPath As String, var
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For iRow = 1 To LastRow
If iRow = LastRow Then
buf = buf & Cells(iRow, 1).Value
Else
buf = buf & Cells(iRow, 1).Value & vbLf
End If
Next
sPath = FSO.BuildPath(OutPutFolder, "gsi" & Format(Now, "yyyyMMddHhmmss") & ".geojson")
With sr
.LineSeparator = adLF
.Type = adTypeText
.Mode = adModeReadWrite
.Charset = "UTF-8"
.Open
.WriteText buf, adWriteChar
.Position = 0
.Type = adTypeBinary
.Position = 3
var = .Read() ' Byte列のコードは失敗 Variantは成功
.Position = 0
.Write var
.SetEOS
.SaveToFile sPath, adSaveCreateNotExist
End With
End Sub
はまった点
BOMを消すときにByte型の配列を使う例は失敗していた。ヴァリアントにすると成功した。
あくまでも整形されたgeojson用
Wordと同じく、いったん整形されたgeojsonを少し編集するという目的で作られている。
このためデータを一から作って出力するものではない。
ただ、このような出力方法であれば少なくとも文字コード、改行コード、BOMについては正しくなる。
怖いのは文字列の中に改行があるかどうかであるが、今後規格が変わっていく可能性はあるが2023年現在のgeojsonのデータはそこまで複雑なものはない。