First job, first task - cell name as atributes in XML creating problems

[Getz]

Hello there, would appreciate little help from you guys! I think it would be of great help to me if we solve this !

The thing is I got a job and am learning VBA with macros in Excel 2000 using WinXP Pro x64.

I got an assignment to update one xls file database table using an xml database that is being created from an another xls database file.

Now I made a macro to export an xls into xml, but the problem is I can not get to open the xml in IE6 or Firefox 3.6 because of false formating of the xml database.

I get this error in IE6 when trying to open it:

The XML page cannot be displayed
Cannot view XML input using XSL style sheet. Please correct the error and then click the Refresh button, or try again later.
<hr> Missing equals sign between attribute and attribute value. Error processing resource 'file:///D:/Documents and Settings/ilb...


Prstasto glodalo D2.5 R1.2 z3
------------^<table width="400"></table>

And the same try in Firefox 3.6:

XML Parsing Error: not well-formed
Location: file:///D:/Documents%20and%20Settings/ilbarisi/Desktop/Ivan%20-%20backup/wip/rezultat.xml
Line Number 3, Column 13:
Prstasto glodalo D2.5 R1.2 z3</puni>
------------^

These files are being used only in the INTRANET of the company, so it won't be an online web application.

I know the problem persists when trying to parsing the cell header name (which contains spaces between words), but I can not get the problem solved.

As I am new in this VBA and Macro programing I would appreciate your help.
If any more info you need, I will certainly provide.

This is a task of emergency that I need (but dont know how) to solve.

P.s. Sorry for any missunderstood statements, I'm from Croatia and not that good in english grammar. :/
<table width="400"></table>

 

[xenou]

If the XML document you create is not well-formed its a bust. You'll have to fix it at its root so that you create a valid XML document -- XML does not allow for even the smallest errors in syntax.

BTW I'd be little nervous using such old applications (Excel 2000, IE6) - and on a 64 bit machine for who knows what reason - XML is a technology that has moved rapidly in the years since these products were released. You really should be using more recent versions if at all possible.

ξ

 

[Getz]

Ok, how do I do that?

p.s. I think I don't have yet the right to ask my boss to update the OS and software installed on it... Its my 2nd week in the firm.

 

[Getz]

Ok so this is how the code looks like for exporting into xml:

it is located in the "export_modul" module

Function fGenerateXML(rngData As Range, rootNodeName As String) As String

'===============================================================
'   XML Tags
    '   Table
    
    Const HEADER                As String = ""
    Dim TAG_BEGIN  As String
    Dim TAG_END  As String
    Const NODE_DELIMITER        As String = "/"
    
        
'===============================================================

    Dim intColCount As Integer
    Dim intRowCount As Integer
    Dim intColCounter As Integer
    Dim intRowCounter As Integer
    
   
    Dim rngCell As Range
 
    
    Dim strXML As String
    
       
    
    '   Initial table tag...
    
    
   TAG_BEGIN = vbCrLf & "<" & rootNodeName & ">"
   TAG_END = vbCrLf & ""
   
    strXML = HEADER
    strXML = strXML & TAG_BEGIN
                    
    With rngData
        
        '   Discover dimensions of the data we
        '   will be dealing with...
        intColCount = .Columns.Count
        
        intRowCount = .Rows.Count
        
        Dim strColNames() As String
        
        ReDim strColNames(intColCount)
        
        
        ' First Row is the Field/Tag names
        If intRowCount >= 1 Then
        
            '   Loop accross columns...
            For intColCounter = 1 To intColCount
                
                '   Mark the cell under current scrutiny by setting
                '   an object variable...
                Set rngCell = .Cells(1, intColCounter)
                
              
                
                '   Is the cell merged?..
                If Not rngCell.MergeArea.Address = _
                                            rngCell.Address Then
               
                      MsgBox ("!! Cell Merged ... Invalid format")
                      Exit Function
                      
                                       
                End If
            
                 strColNames(intColCounter) = rngCell.Text
                
            Next
        
        End If
        
        
        Dim Nodes() As String
        Dim NodeStack() As String
      
      
        '   Loop down the table's rows
        For intRowCounter = 2 To intRowCount
           
            
            strXML = strXML & vbCrLf & TABLE_ROW
            ReDim NodeStack(0)
            '   Loop accross columns...
            For intColCounter = 1 To intColCount
                
                '   Mark the cell under current scrutiny by setting
                '   an object variable...
                Set rngCell = .Cells(intRowCounter, intColCounter)
                
                               
                '   Is the cell merged?..
                If Not rngCell.MergeArea.Address = _
                                            rngCell.Address Then
                
                      MsgBox ("!! Cell Merged ... Invalid format")
                      Exit Function
                      
                End If
               
                If Left(strColNames(intColCounter), 1) = NODE_DELIMITER Then
                      
                      Nodes = Split(strColNames(intColCounter), NODE_DELIMITER)
                          ' check whether we are starting a new node or not
                          Dim i As Integer
                         
                          Dim MatchAll As Boolean
                          MatchAll = True
                         
                          
                          For i = 1 To UBound(Nodes)
    
                              If i <= UBound(NodeStack) Then
                                  
                                  If Trim(Nodes(i)) <> Trim(NodeStack(i)) Then
                                      'not match
                                      'MsgBox (Nodes(i) & "," & NodeStack(i))
                                      MatchAll = False
                                      Exit For
                                  
                                  End If
                              Else
                                MatchAll = False
                                Exit For
                              End If
                              
                              
                                                                                
                          Next
                          
                          ' add close tags to those not used afterwards
                          
              
                         ' don't count it when no content
                         If Trim(rngCell.Text) <> "" Then
                            
                            If MatchAll Then
                              strXML = strXML & "" & vbCrLf
                            Else
                              For t = UBound(NodeStack) To i Step -1
                                strXML = strXML & "" & vbCrLf
                              Next
                            End If
                            
                            If i < UBound(Nodes) Then
                                For t = i To UBound(Nodes)
                                    ' add to the xml
                                    strXML = strXML & "<" & Nodes(t) & ">"
                                    If t = UBound(Nodes) Then
                                                                           
                                            strXML = strXML & Trim(rngCell.Text)
                                        
                                    End If
                                    
                                Next
                              Else
                                  t = UBound(Nodes)
                                  ' add to the xml
                                  strXML = strXML & "<" & Nodes(t) & ">"
                                  strXML = strXML & Trim(rngCell.Text)

                              End If
                           
                              NodeStack = Nodes
                           
                          Else
                          
                            ' since its a blank field, so no need to handle if field name repeated
                            If Not MatchAll Then
                              For t = UBound(NodeStack) To i Step -1
                                strXML = strXML & "" & vbCrLf
                              Next
                            End If
                            
                            ReDim Preserve NodeStack(i - 1)
                          End If
                            
                                              
                          ' the last column
                          If intColCounter = intColCount Then
                           ' add close tags to those not used afterwards
                              If UBound(NodeStack) <> 0 Then
                               For t = UBound(NodeStack) To 1 Step -1
                          
                              strXML = strXML & "" & vbCrLf
                              
                              Next
                              End If
                          End If
                   
                 Else
                      ' add close tags to those not used afterwards
                      If UBound(NodeStack) <> 0 Then
                          For t = UBound(NodeStack) To 1 Step -1
                          
                           strXML = strXML & "" & vbCrLf
                              
                          Next
                      End If
                      ReDim NodeStack(0)
      
                        ' skip if no content
                      If Trim(rngCell.Text) <> "" Then
                        strXML = strXML & "<" & Trim(strColNames(intColCounter)) & ">" & Trim(rngCell.Text) & "" & vbCrLf
                      End If
                      
                  End If
                
                    
                
                
            Next
           
        Next
    End With
    
    strXML = strXML & TAG_END
    
    '   Return the HTML string...
    fGenerateXML = strXML
    
End Function



' Function for writing plain string out a file

Sub sWriteFile(strXML As String, strFullFileName As String)

    Dim intFileNum As String
    
    intFileNum = FreeFile
    Open strFullFileName For Output As #intFileNum
    Print #intFileNum, strXML
    Close #intFileNum
    
    
End Sub

' To automatically select the "REAL"/non empty continuous regions (rows and columns)

Sub FindUsedRange()
    Dim LastRow As Long
    Dim FirstRow As Long
    Dim LastCol As Integer
    Dim FirstCol As Integer

    ' Find the FIRST real row
    FirstRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByRows).Row
      
    ' Find the FIRST real column
    FirstCol = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlNext, _
      SearchOrder:=xlByColumns).Column
    
    ' Find the LAST real row
    LastRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    ' Find the LAST real column
    LastCol = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column
        
'Select the ACTUAL Used Range as identified by the
'variables identified above
    'MsgBox (FirstRow & "," & LastRow & "," & FirstCol & "," & LastCol)
    Dim topCel As Range
    Dim bottomCel As Range
   
    Set topCel = Cells(FirstRow, FirstCol)
    Set bottomCel = Cells(LastRow, LastCol)
    
   ActiveSheet.Range(topCel, bottomCel).Select
End Sub

As I dont clearly understand the whole code, this is just an edit of an older version of the program code to work a lil bit simplified.
So the original code is not mine. As I repeat, I am still learning to use this code correctly.


I think we could find the solution to the problem of the emtpy spaces in the names of the header rows of the table which cause the problems of not opening the xml file in IE6 or Firefox 3.

So it goes like this:

Sub CreateNames()


    Dim wb As Workbook, ws As Worksheet
    Dim lrow As Long, lcol As Long, i As Long
    Dim myName As String, Start As String

    ' set the row number where headings are held as a constant
    ' change this to the row number required if not row 1
    Const Rowno = 1

    ' set the Offset as the number of rows below Rowno, where the
    ' data begins
    Const ROffset = 1

    ' set the starting column for the data, in this case 1
    ' change if the data does not start in column A
    Const Colno = 1
    
    ' Set an Offset from the starting column, for the column number that
    ' will always have data entered, and will therefore be used in calculating lrow
    
    Const COffset = 0  ' in this case, the first column will always contain data.

    On Error GoTo CreateNames_Error

    Set wb = ActiveWorkbook
    Set ws = ActiveSheet

    ' count the number of columns used in the row designated to
    ' have the header names
 
    lcol = Cells(Rowno, Columns.Count).End(xlToLeft).Column
    lrow = ws.Cells(Rows.Count, Colno).End(xlUp).Row
    Start = Cells(Rowno, Colno).Address
    
    wb.Names.Add Name:="lcol", RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")"
    wb.Names.Add Name:="lrow", RefersToR1C1:="=COUNTA(C" & Colno + COffset & ")"
    wb.Names.Add Name:="myData", RefersTo:= _
                  "=" & Start & ":INDEX($1:$65536," & "lrow," & "Lcol)"

    For i = Colno To lcol
        ' if a column header contains spaces, replace the space with an underscore
        ' spaces are not allowed in range names.
        myName = Replace(Cells(Rowno, i).Value, " ", "_")
        If myName = "" Then
            ' if column header is blank, warn the user and stop the macro at that point
            ' names will only be created for those cells with text in them.
            MsgBox "Missing Name in column " & i & vbCrLf _
                   & "Please Enter a Name and run macro again"
            Exit Sub
        End If
        wb.Names.Add Name:=myName, RefersToR1C1:= _
                     "=R" & Rowno + ROffset & "C" & i & ":INDEX(C" & i & ",lrow)"
nexti:
    Next i

    On Error GoTo 0
        MsgBox "All dynamic Named ranges have been created"
    Exit Sub

    Exit Sub

CreateNames_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & _
    ") in procedure CreateNames."

End Sub

Now the question is, how to get this thing working? :/

I tried to put this solution in the same module...

The main goal is to get the xml file exported from the xls data table in correct form, so it can be opened to check in the browsers mentioned before in this post.

P.s. Sorry for the double post... I am in a hurry with this task as my boss is not happy with me it seems

 

[Getz]

Problem solved! You can lock or delete the topci!