私は、ユーザーが住所(番号)、ストリート、タウン、郡、州の形式で住所を入力できるようにするアクセスフォームを作成しています。これが完了すると、ボタンをクリックして、その住所に目印を定義したKMLファイルを生成し、Google Earthで開くことができます。ただし、ファイルを開くと、「結果がありません - 空のKMLファイル」というエラーが表示されます。ファイルエクスプローラで手動でファイルを開くと、目印は(ほぼ)期待どおりに生成されます。入力コードaddress = 3
、street = "Todd Lane"
、Town = "Old Tappan"
、County = Bergen
、State = "New Jersey"
のメソッドコードと生成されたKMLを以下に示します。VBA subはファイルエクスプローラとは異なるファイルを読み込みます
Private Sub ExportToKMLButton_Click()
Dim FName As String
FName = "C:\Users\Public\QueryOutput.KML"
Close #1 'Make sure nothing is already open as #1.
Open FName For Output As #1 'Open the file defined by FName.
Dim outputtext As New Collection
outputtext.Add "<?xml version=""1.0"" encoding=""UTF-8""?>" 'Denotes the language to follow.
outputtext.Add Item:="<kml xmlns=""http://earth.google.com/kml/2.0"">"
outputtext.Add Item:="<Document>"
outputtext.Add Item:="<Placemark>"
outputtext.Add Item:="<name>Active Location</name>"
outputtext.Add Item:="<lookat>Active Location</name>"
outputtext.Add Item:="<address>" & Address.Value & " " & Street.Value & _
", " & Town.Value & ", " & County.Value & " County, " & State.Value & "</address>"
outputtext.Add Item:="</Placemark>"
outputtext.Add Item:="</Document>"
outputtext.Add Item:="</kml>"
Dim output As String
Dim i As Long
For i = 1 To outputtext.Count
output = output & outputtext.Item(i)
Next i
output = Replace(output, "&", "and") 'Remove any ampersands from the output to avoid errors.
Print #1, output 'Print to file.
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run FName, 1, True
On Error GoTo EndOfExport 'If the user runs this function twice consecutively, without closing Google Earth, both instances of the function _
will resume simultaneously when Earth is closed. One will delete the single extant copy of the KML file, and the _
other will attempt to do the same. When the file is not found, an error will occur. This error does no harm, so _
we simply skip it and end the function.
'Kill FName 'Deletes the generated file after opening it.
GoTo EndOfExport
ErrorFound:
MsgBox ("An error has occurred. Your export may be incomplete.")
EndOfExport:
Close #1
End Sub
そして、生成されたKML(読みやすくするために編集されません。元には改行を):
<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://earth.google.com/kml/2.0">
<Document>
<Placemark>
<name>Active Location</name>
<address>3 Todd Lane, Old Tappan, Bergen County, New Jersey</address>
</Placemark>
</Document>
</kml>