More than 1 year has passed since last update.

Word　VBA GeoJsonファイルを出力させる

Posted at 2023-09-08

想定されるのは簡易な修正

前提

すでに成形され、出力されているgeojsonファイルがある

目的

地番等を間違えたので修正する
あるいは色を変えるなど、置換機能を使いたい。
間違えた時には戻ってほしい。

制約

保存するときに一度全文を読み込むため、あまり巨大なファイルはおすすめできない。
また、中間テキストファイルを作るので、当該ドライブの容量が２倍必要となる。

geojsonの特徴

UTF-8 65001
改行コードがWindowsのvbCrLfではなくvbLF
なのでメモ帳ではUnixと表示される。
BOMはないのが標準だが、あっても動くときがあり、この辺はあいまい。

コード

留意事項

出力先は Const OutPutDrive = "C:\hoge"で決まるので、各自出力先を変えること。
例 Const OutPutDrive = "D:\"

参照設定が必要です

Sub geoJasonExport()
' For Microsoft Word
' 現在開いている Word Document でGeoJsonを編集している
' GeoJasonを編集したあとに実行し、新たなGeoJsonファイルを作成する。
' Json形式に整形する機能はない
' 文字コード 65001 改行　vbLF BOMなし UTF-8Nと言われる場合もある。
' 参照設定　VBScript Regular expression 5.5,
           ' Microsoft Scripting Runtime
           ' Microsoft ActiveX Data Object 6.1
           
    Const OutPutDrive = "D:\" ' 出力フォルダの決定
    Dim FSO As New Scripting.FileSystemObject
    Dim oFile As File, oFile2, oInFile, oFolder As Folder
    Dim wDoc As Word.Document: Set wDoc = ThisDocument
    Dim wRng As Word.Range, wPara As Word.Paragraph
    Dim sr As ADODB.Stream
    Dim MC As MatchCollection, M As Match, Reg As New RegExp
    Dim buf As String
    Dim vbuf
    Dim sPath As String, sOutFile As String
    Dim cnt As Long

    buf = ""
    sPath = FSO.BuildPath(OutPutDrive, "gsi" & Format(Now, "yyyyMMddHHmmss") & ".geojson") ' ファイル名の決定
    For cnt = 1 To wDoc.Paragraphs.Count
      Set wPara = wDoc.Paragraphs(cnt)
      If cnt = wDoc.Paragraphs.Count Then
        buf = Left(Replace(buf & wPara.Range.Text, vbCrLf, vbLf, 1, -1, vbTextCompare), Len(Replace(buf & wPara.Range.Text, vbCrLf, vbLf, 1, -1, vbTextCompare)) - 1)
      Else
        buf = buf & wPara.Range.Text & vbLf
      End If
    Next
    Set sr = New ADODB.Stream
    With sr
        '.Mode = adModeReadWrite ' なぜかModeはいらないらしい
        .LineSeparator = adLF
        .Charset = "UTF-8"
        .Type = adTypeText
        .Open
        .WriteText buf, adWriteChar
        .Position = 0
        .Type = adTypeBinary
        .Position = 3
        vbuf = .Read
        .SetEOS
        .Position = 0 'もう一度0に戻して
        .Write vbuf ' Binaryなので、WriteTextではなく Write
        .SaveToFile sPath, adSaveCreateNotExist
        .Close
    End With
    Set sr = Nothing
End Sub

はまった点

なぜか、一発でできない。ラインセパレーターとか決めればいけそうだができない。
次に、改行コードをVBCRLFにしておいて、あとで置換する、というのもうまくいかない。
なので、１行づつ読み込み、そのたびにvbLFをつける形でやらないと失敗するらしい。
BOMなしかと思ったが、BOMありだった。
また、Wordだと、最後に改行がはいるので、Left(vbuf, Len(vbuf) - 1)削除が必要

Windows + Officeではgeojsonには太刀打ちできない

今回の件で痛感したのは、WindowsとOfficeのデフォルトではDXなどできるわけがないということである。
何しろJson,GeoJasonがあまりうまく扱えない。
しかもScriptContorolが64bitでは使えない。
こんなものでDXとか言っていたら頭がおかしいと言わざるを得ない。
そもそもGeoJsonファイルすらまともにできないということは地理データを扱えず、分析も困難だということ意味している。
往年のMSならここでどっかを買収とかしそうなのだが。