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

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壳）：

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> 

ACCESS 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"