excel中如何利用VBA批量生成XML文件

定义一个宏，代码如下：

Sub SaveXML()
    If MsgBox("Are you sure create xml?", vbYesNo) = vbYes Then
    
        ActiveWorkbook.Save
        
        Dim xlsname, filepath
        xlsname = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
        filepath = ThisWorkbook.Path
    
        Dim objStream As Object
        Set objStream = CreateObject("ADODB.Stream")
        
        objStream.Open
        objStream.Position = 0
        objStream.Charset = "UTF-8"
        
        objStream.WriteText "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf
        objStream.WriteText "<" & xlsname & "> " & vbCrLf
        
        For Each sh In ActiveWorkbook.Worksheets
            Dim rng As Range
            Set rng = sh.Range("A1")
            
            Dim count1, count2, count3
            count1 = 2
            count2 = 2
            count3 = 0
            Dim columnName As String
        
            If rng.Offset(1, 1) = "Child" Then
            
            ElseIf rng.Offset(1, 1) = "" Then
                
                objStream.WriteText vbTab & "<" & sh.Name & "s>" & vbCrLf
                 
                objStream.WriteText vbTab & "</" & sh.Name & "s>" & vbCrLf
            Else
                objStream.WriteText vbTab & "<" & sh.Name & "s>" & vbCrLf
             
                Do While rng.Offset(count1, 0) <> ""
                    objStream.WriteText vbTab & vbTab & "<" & sh.Name
                    
                    Do While rng.Offset(2, count3) <> ""
                        columnName = rng.Offset(1, count3)
                        If InStr(1, columnName, "_") <> 0 Then
                            objStream.WriteText " " & Right(columnName, Len(columnName) - InStr(1, columnName, "_")) & "=" & """"
                            objStream.WriteText rng.Offset(count1, count3) & """"
                        End If
                        count3 = count3 + 1
                    Loop
                    count3 = 0
                    objStream.WriteText "/>" & vbCrLf
    
                    count1 = count1 + 1
                Loop
                MsgBox ("555555")
                count1 = 2
                count2 = 2
                
                objStream.WriteText vbTab & "</" & sh.Name & "s>" & vbCrLf
            End If
        Next
        objStream.WriteText "</" & xlsname & ">" & vbCrLf
        
        objStream.SaveToFile filepath + "\" + xlsname + ".xml", 2
        objStream.Close
        
        Set objStream = Nothing
    End If
End Sub