Google Earth批量生成地标文件（kml）的Excel VBA代码

转载自https://www.xuebuyuan.com/355105.html

Google Earth批量生成地标文件（kml）的Excel VBA代码
2012年05月17日 ⁄ 综合 ⁄ 共 5510字 ⁄ 字号 小 中 大 ⁄ 评论关闭

据一哥们需求，要把N（N>20000）多点添加到google earth中，这么繁杂、重复的工作怎么能用体力来完成呢，于是向我求助。

整理的地标包括名称、东经、北纬等数据，存储在excel文件中（第一列为名称，第二列为东经，第三列为北纬，坐标以小数度为单位，而不是度分秒）。开始想用按键精灵，但发现要实现在excel对不同行取位置不好办。于是研究google earth，随意添加了两个地标，然后右键另存为kml文件，用emeditor打开，发现就是个xml格式的文件，里面包括了众多信息，当然坐标也在其中。据此，从这个kml文件入手开始计划用vba来生成这样一个文件。以前没接触过，简单分析了一下，只需要填入几个数据就OK。于是动手，代码如下：

1 Sub GenPlacemark()
2 Dim i As Integer
3 Dim s As String '存储生成的代码
4 Dim f as String '保存的文件名
5 f=“c:\point.kml”
6 s = “” & Chr(10) & _
7 “” & Chr(10) & _
8 “” & Chr(10) & _
9 “临时位置.kml” & Chr(10) & _
10 “” & Chr(10) & _
11 “” & Chr(10) & _
12 “normal” & Chr(10) & _
13 “#sn_ylw-pushpin” & Chr(10) & _
14 “” & Chr(10) & _
15 “” & Chr(10) & _
16 “highlight” & Chr(10) & _
17 “#sh_ylw-pushpin” & Chr(10) & _
18 “” & Chr(10) & _
19 “”
20 s = s & “” & Chr(10) & _
58 “” & Chr(10) & _
59 “absolute” & Chr(10) & _
60 “gx:altitudeModeclampToSeaFloor” & Chr(10) & _
61 “” & Sheet1.Cells(i, 2).Value & “,” & Sheet1.Cells(i, 3).Value & “,0” & Chr(10) & _
62 “” & Chr(10) & _
63 “” & Chr(10)
64 SaveFile s, f
65 Next
66 s = “”
67 SaveFile s, f
68 MsgBox “down”
69 End Sub
70
71 Sub SaveFile(sql As String, fileName As String)
72 '--------------------------------------------------------------
73 '功 能：保存语句,若已存在文件则直接追加,若文件不存在在先新建.
74 '作 者：erqie
75 '制作日期：2009-08-24
76 '修订日期：
77 'ForReading 1 以只读方式打开文件。 不能写这个文件。
78 'ForWriting 2 以写方式打开文件
79 'ForAppending 8 打开文件并从文件末尾开始写。
80 '--------------------------------------------------------------
81 Dim fso, MyFile
82 Set fso = CreateObject(“Scripting.FileSystemObject”)
83 If (fso.fileExists(fileName)) Then
84 '参数8表示在文件末尾追加写入
85 Set MyFile = fso.OpenTextFile(fileName, 8)
86 'fso.Delete (fileName)
87
88 Else
89 'ture表示覆盖创建
90 Set MyFile = fso.CreateTextFile(fileName, ture)
91 End If
92 MyFile.writeline (sql)
93 MyFile.Close
94 Set fso = Nothing
95 Set MyFile = Nothing
96 End Sub
其中GenPlacemark过程用于生成kml文件主体，基本思路：1.把kml文件的样式设置等固定部分先保存到变量s里（for循环以前），2.循环excel里存储的地标信息，并生成相应的Placemark段，具体位于代码的for循环体里。

SaveFile函数是用来保存文件的。

需要注意的是：1.kml文件坐标生效的地方位于：

“” & Sheet1.Cells(i, 2).Value & “,” & Sheet1.Cells(i, 3).Value & “,0”
而不是

“” & Sheet1.Cells(i, 2).Value & “” & Chr(10) & _
“” & Sheet1.Cells(i, 3).Value & “” & Chr(10) & _
2.保存文件函数经过了多次调用，这是因为如果把所有信息都存储到变量s里，最后保存，excel会死掉，所以不得不在中间生成一段代码就保存一次。
3.使用vba保存的文件格式是gb2312的，而google earth只次utf8的编码，所以尽管生成的kml文件头里注明了

“”

但实际是不生效的，需要用文本编辑器，如;emeditor、editplus等将生成的文件另存为utf8编码。尝试过把

“”
改成

“”
但google earth不认，只好手动转字体编码了。主要是考虑到中文 地标名称，如果不是utf8编码，用google earth打开后会乱码，改完后就OK了。

使用此脚本步骤：打开保存有地标信息的excel文件，确保第一列为名称、第二列为东经，第三列为北纬，坐标以小数度为单位。按alt+f11调出vba编辑器，把kml脚本粘贴过去，使光标位于genplacemark函数体任意位置，按f5运行。结果默认保存在c盘根目录。由于保存时用的是追加写入的方式，因此每次运行前先删除c盘根目录下以前生面的point.kml文件。