VBA 访问：将各种记录组织到 KML 文件夹中

Question

我正在 Access 中创建一个程序，该程序将带坐标的 table 导出到可查看的 KML 文件中。目前我使用的代码从记录集的开头开始，并将每条记录单独打印到 KML 文件中。

但是我想让代码将记录组织到 KML 文件上的文件夹中（基于它们创建的周）。我能找到的将文件夹编码到 KML 文件中的唯一方法要求我将条目嵌套到代码的特定部分。因为我是从上到下写我的记录，而且它们没有按我希望它们排序的顺序出现问题。

我是 VBA 的新手，我想解决这个问题的唯一方法是多次检查我的记录集，每次检查不同的一周，这样我就可以将其写入 KML 文件中的正确位置。虽然数据库相当大，但我觉得应该有一种更简单或更简洁的方法来做到这一点。

如有任何帮助或建议，我们将不胜感激。我当前的代码（只是写入 KML 的部分）

Open strSavePath For Output Shared As #1

'init KML file
Print #1, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #1, "<kml xmlns=""http://www.opengis.net/kml/2.2"">"
Print #1, "<Document>"
'create plot styles
Print #1, "<Style id=""K1res"">"
Print #1, "<IconStyle> <color>ff14F0FF</color> <Icon><href>http://maps.google.com/mapfiles/kml/pal4/icon57.png</href></Icon></IconStyle>"
Print #1, "</Style>"

Print #1, "<Style id=""K1com"">"
Print #1, "<IconStyle> <color>FF1473FF</color> <Icon><href>http://maps.google.com/mapfiles/kml/pal4/icon57.png</href></Icon></IconStyle>"
Print #1, "</Style>"

With MyRS
Do Until .EOF
Print #1, "   <Placemark>"
If Me.boxPlotTitle.Value = True Then
Print #1, "      <name>" & DateShort(MyRS.Fields(4)) & "</name>"
End If

Print #1, "      <description>" & CleanupStr(MyRS.Fields(8)) & vbNewLine & vbNewLine & "Date: " & MyRS.Fields(4) & "</description>"



If MyRS.Fields(6) = "Residential" Then
    Print #1, "      <styleUrl>#K1res</styleUrl>  "
Else
    Print #1, "      <styleUrl>#K1com</styleUrl>  "
End If

Print #1, "      <Point>"
strText = "         <coordinates>" & MyRS.Fields(11) & "," & MyRS.Fields(10) & "</coordinates>"
Print #1, strText
Print #1, "      </Point>"
Print #1, "   </Placemark>"
.MoveNext
Loop
End With

Print #1, "</Document>"
Print #1, "</kml>"

Egress:
On Error Resume Next
Close #1
MyRS.Close
Set MyRS = Nothing
Set MyDB = Nothing

MsgBox "Successfully Exported KML"
Call Shell("explorer.exe " & strSavePath, vbNormalFocus)

Exit Sub

ErrHandler:
MsgBox Err.Description
Resume Egress

End Sub

Answer 1

首先，KML 是一个特殊的 XML 文件。并且 Access 可以将 table 和查询数据导出为 XML 格式。因此，您可以轻松地将坐标数据导出到 XML，而无需遍历记录集：

Application.ExportXML acExportQuery, "yourtableorqueryname", "\path\to\file.xml"

但是，KML 需要特殊的 headers，它需要与您的坐标数据合并。有了它，您可以考虑使用带有 VBA 的 MSXML object 的 xsl 样式表来转换它（基本上将查询输出附加到 KML shell）：

XML 文件（待转换）

<?xml version="1.0" encoding="UTF-8"?>
<kml>
    <Document>
        create plot styles
        <Style id="K1res">
            <IconStyle> <color>ff14F0FF</color> <Icon><href>http://maps.google.com/mapfiles/kml/pal4/icon57.png</href></Icon></IconStyle>
        </Style>
        <Style id="K1com">
            <IconStyle> <color>FF1473FF</color> <Icon><href>http://maps.google.com/mapfiles/kml/pal4/icon57.png</href></Icon></IconStyle>
        </Style>

    <Dataroot>

    </Dataroot>

    </Document>
</kml>

XSL（转换样式表）

<xsl:transform version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output version="1.0" encoding="UTF-8"/>

    <xsl:template match="@*|node()">
        <xsl:copy>
            <xsl:apply-templates select="@*|node()"/><xsl:text>&#xA;</xsl:text><xsl:text>&#xA;</xsl:text>  
        </xsl:copy>
    </xsl:template>

    <xsl:template match='//Document/Dataroot'>        
            <xsl:copy-of select="document('yourtablequeryoutput.xml')/Placemark"/><xsl:text>&#xA;</xsl:text>        
    </xsl:template>


</xsl:transform>

访问VBA（转换，保存输出）

''IN REFERENCE LIBRARY SELECT THE Microsoft XML, v3.0
Dim xmlfile As New MSXML2.DOMDocument   
Dim xslfile As New MSXML2.DOMDocument    
Dim newXMLDoc As New MSXML2.DOMDocument 

Application.ExportXML acExportQuery, "yourtableorqueryname", "\path\to\file.xml"

xmlfile.SetProperty "AllowDocumentFunction", True
xmlfile.async = False
xmlfile.Load "\path\to\abovexmlfiletobetransformed.xml"


xslfile.SetProperty "AllowDocumentFunction", True
xslfile.async = False
xslfile.Load "\path\to\abovexslfilethattransforms.xsl"


xmlfile.transformNodeToObject xslfile, newXMLDoc
newXMLDoc.Save "\path\to\finaloutput.xml"

VBA 访问：将各种记录组织到 KML 文件夹中

VBA Access: organize assorted records into KML folders

xml

vba

ms-access

directory

kml