Question

我正在Access中创建一个程序，该程序将带坐标的表导出到可查看的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可以将表和查询数据导出为XML格式。因此，您可以轻松地将坐标数据导出到XML中，而无需遍历记录集：

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

但是，KML需要特殊的标题，需要与您的坐标数据合并。有了这个，您可以考虑使用xsl样式表和VBA的MSXML object来对其进行转换（基本上将查询输出附加到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 Access：将各种记录组织到KML文件夹中

1 个答案: