适用于Mac Excel的XLS到XML宏

Question

我需要将电子表格转换为基本的XML格式。电子表格如下所示：

我希望电子表格中的每一行在XML上都是这样的：

<item>
   <title>Directory Name</title>
   <address>Address, City, State</address>
   <phone>Phone</phone>
   <cell>Cell Phone</cell>
</item>

有什么建议吗？

更新：根据我阅读的一些内容，根据@ Sancho.s建议的代码，我使用了以下宏：

Sub xls2xml()
    Dim rng1 As Range, rng2 As Range, cl As Range
    Set rng1 = Range("A2")
    Set rng1 = Range(rng1, rng1.End(xlDown))
    For Each cl In rng1
      Call dump_xml_line(cl)
    Next cl

End Sub

Sub dump_xml_line(cl As Range)
Dim n As Integer

n = FreeFile()
Open "C:\Users\Me\test.txt" For Output As #n


    Print #n, "<item>"
    Print #n, "   <title>" & cl.Text & "</title>"
    Print #n, "   <address>" & cl.Offset(0, 2).Text & "</address>"
    Print #n, "   <phone>" & cl.Offset(0, 1).Text & "</phone>"
    Print #n, "   <cell>" & cl.Offset(0, 3).Text & "</cell>"
    Print #n, "</item>"
    Close #n
End Sub

我不得不使用Print而不是Debug.Print，因为不允许立即窗口显示超过200行，这比所有这些的输出要小得多。使用此代码，它会创建test.txt文件，但只将最后一行放入文件中，而不是全部放入。这有什么问题？

Answer 1

此代码应该适合您。它几乎是不言自明的，适应应该很容易。要使用其他操作补充此代码，您可能会发现，如果您需要检查给定任务的（近似）代码，则记录宏会很有帮助。

Sub xls2xml()
    Dim rng1 As Range, rng2 As Range, cl As Range
    Set rng1 = Range("A2")
    Set rng1 = Range(rng1, rng1.End(xlDown))
    For Each cl In rng1
      Call dump_xml_line(cl)
    Next cl
End Sub

Sub dump_xml_line(cl As Range)
    Debug.Print "<item>"
    Debug.Print "   <title>" & cl.Text & "</title>"
    Debug.Print "   <address>" & cl.Offset(0, 2).Text & "</address>"
    Debug.Print "   <phone>" & cl.Offset(0, 1).Text & "</phone>"
    Debug.Print "   <cell>" & cl.Offset(0, 3).Text & "</cell>"
    Debug.Print "</item>"
End Sub

然后您可以从即时窗口复制输出。

祝你好运。

---

修改 要写入文件而不是立即窗口，请使用以下（也是不言自明的）（请参阅How can I write to a text file reliably from Excel VBA?）

Sub xls2xml_2()
    Dim rng1 As Range, rng2 As Range, cl As Range
    Set rng1 = Range("A2")
    Set rng1 = Range(rng1, rng1.End(xlDown))

    Dim strPath As String
    strPath = "test2.txt"
    Dim fnum As Integer
    fnum = FreeFile()
    Open strPath For Output As #fnum

    For Each cl In rng1
      Call write_xml_line_2(cl, fnum)
    Next cl

    Close #fnum
End Sub

Sub write_xml_line_2(cl As Range, fnum As Integer)
    Print #fnum, "<item>"
    Print #fnum, "   <title>" & cl.Text & "</title>"
    Print #fnum, "   <address>" & cl.Offset(0, 2).Text & "</address>"
    Print #fnum, "   <phone>" & cl.Offset(0, 1).Text & "</phone>"
    Print #fnum, "   <cell>" & cl.Offset(0, 3).Text & "</cell>"
    Print #fnum, "</item>"
End Sub

还有另一种选择（见How to create and write to a txt file using VBA）：

Sub xls2xml_1()
    Dim rng1 As Range, rng2 As Range, cl As Range
    Set rng1 = Range("A2")
    Set rng1 = Range(rng1, rng1.End(xlDown))

    Dim strPath As String
    strPath = "test1.txt"
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(strPath)

    For Each cl In rng1
      Call write_xml_line_1(cl, oFile)
    Next cl

    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
End Sub

Sub write_xml_line_1(cl As Range, oFile As Object)
    oFile.WriteLine "<item>"
    oFile.WriteLine "   <title>" & cl.Text & "</title>"
    oFile.WriteLine "   <address>" & cl.Offset(0, 2).Text & "</address>"
    oFile.WriteLine "   <phone>" & cl.Offset(0, 1).Text & "</phone>"
    oFile.WriteLine "   <cell>" & cl.Offset(0, 3).Text & "</cell>"
    oFile.WriteLine "</item>"
End Sub

Answer 2

如果您的目标是获取转换后的文本，并且您不必使用VBA（您没有指定这种情况），那么您可以将工作表导出为csv，并使用其他程序（比如说） ，在Objective C）进行转换。

您需要多点几次点击，但如果您想要“升级”您的工作表或您将来执行的操作以获取XML，那么您可能会对此选项感到更舒服，该选项功能齐全