如何使用vb.net检索具有合并单元格的复杂Excel文件并另存为xml文件？

Question

I have this that can retrieve excel file and save as xml file.

Imports Microsoft.Office.Interop.Excel
Imports System.Xml
Imports System.IO

Module Module1
Sub Main()
    Try
        Dim excel As Application = New Application
        Dim filename As String = "person"
        Dim file_extension As String
        Dim path As String = "C:\Users\"
        Dim w As Workbook
        Try
            file_extension = "xlsx"
            w = excel.Workbooks.Open(path & filename + "." & file_extension)
        Catch ex As Exception
            file_extension = "xls"
            w = excel.Workbooks.Open(path & filename + "." & file_extension)
        End Try

        For i As Integer = 1 To w.Sheets.Count
            Dim sheet As Worksheet = w.Sheets(i)
            Dim r As Range = sheet.UsedRange
            Dim array(,) As Object = r.Value(XlRangeValueDataType.xlRangeValueDefault)

            If array IsNot Nothing Then

                Dim bound0 As Integer = array.GetUpperBound(0)
                Dim bound1 As Integer = array.GetUpperBound(1)

                Dim settings As XmlWriterSettings = New XmlWriterSettings()
                settings.Indent = True

                Using writer As XmlWriter = XmlWriter.Create(filename + ".xml", settings)
                    writer.WriteStartDocument()
                    writer.WriteStartElement(filename)
                    For j As Integer = 2 To bound0
                        writer.WriteStartElement(sheet.Name)
                        For x As Integer = 1 To bound1
                            writer.WriteElementString(array(1, x), array(j, x))
                        Next
                        writer.WriteEndElement()
                    Next
                    writer.WriteEndElement()
                    writer.WriteEndDocument()
                End Using
            End If
        Next
        w.Close()
    Catch ex As Exception
        Console.WriteLine("MS Excel file is invalid.")
        Console.WriteLine(ex.Message)
        Console.ReadKey()
    End Try
End Sub
End Module

When I have this, for example, as my excel file:

filename: person.xlsx sheet name: personfile

Name     Age     Gender
John     5       M
Jane     4       F

Then the xml file will return this way.

<person>
 <personfile>
  <Name>John</Name>
  <Age>5</Age>
  <Gender>M</Gender>
 </personfile>
 <personfile>
  <Name>Jane</Name>
  <Age>4</Age>
  <Gender>F</Gender>
 </personfile>
</person>

which is saved as person.xml

Now my question is... what if the excel file has merged cells? How to solve the error? When the excel file has merged cells, it returns

ERROR: Index and length must refer to a location within the string
Parameter name: length

Here's the sample excel file that I am supposed to retrieve.

PS There are combo boxes too.

Answer 1

The code treats the table as a two-dimensional array with no merged cells. The best approach would be to apply it to part(s) of the table that fit those criteria, eg don't have merged cells in them.

Depending on how fixed or varied the structure is from document to document, this can be easy or very hard.

Assuming the data you need is always in the same fixed place, you can set the r variable to the relevant range instead of the whole sheet.

Answer 2

This works on a test sheet I made with a couple of different merged cell situations:

Private Sub Main
    Try
        Dim excel As Application = New Application
        Dim filename As String = "person"
        Dim file_extension As String
        Dim path As String = "C:\Users\"
        Dim w As Workbook
        Try
            file_extension = "xlsx"
            w = excel.Workbooks.Open(path & filename + "." & file_extension)
        Catch ex As Exception
            file_extension = "xls"
            w = excel.Workbooks.Open(path & filename + "." & file_extension)
        End Try

        For i As Integer = 1 To w.Sheets.Count
            Dim sheet As Object = w.Sheets(i)
            Dim r As Object = sheet.UsedRange

            'Changes to your original code begin here

            Dim bound0 As Integer = r.Rows.Count
            Dim bound1 As Integer = r.Columns.Count
            Dim array(bound0, bound1) As Object
            For a As Integer = 1 To bound0
                For b As Integer = 1 To bound1
                    Try
                        array(a, b) = r.Cells(a, b).Value
                    Catch
                        array(a, b) = Nothing
                    End Try
                Next
            Next

            If array IsNot Nothing Then 'I left this in, though I can't imagine how it could be needed now

                Dim settings As XmlWriterSettings = New XmlWriterSettings()
                settings.Indent = True

                Using writer As XmlWriter = XmlWriter.Create(filename + ".xml", settings)
                    writer.WriteStartDocument()
                    writer.WriteStartElement(filename)
                    For j As Integer = 2 To bound0
                        writer.WriteStartElement(sheet.Name)
                        For x As Integer = 1 To bound1
                            If array(j, x) IsNot Nothing Then
                                Dim h As Integer = x
                                Do Until array(1, h) IsNot Nothing
                                    h -= 1
                                Loop
                                writer.WriteElementString(array(1, h), array(j, x))

                                'No more changes to your code after this point

                            End If
                        Next
                        writer.WriteEndElement()
                    Next
                    writer.WriteEndElement()
                    writer.WriteEndDocument()
                End Using
            End If
        Next
        w.Close()
    Catch ex As Exception
        Console.WriteLine("MS Excel file is invalid.")
        Console.WriteLine(ex.Message)
        Console.ReadKey()
    End Try
End Sub