XML / XSL

Option Explicit
Sub Sort_and_Eliminate_doubles_and_Send()
'   This macro is written by Erik van Dyck
'
    Dim OldFn, ShortFn As String, NewFn As String, FnRoot As String, DirDest As String, FN As String
    Dim rownumber As Integer, colnumber As Integer, n As Integer
    Dim MailAd As Variant, RRange As Variant
    Dim fso As Object

'   Hide screen
    Application.DisplayAlerts = False
'   Stop "EnableEvents" while making automatic changes
    Application.EnableEvents = False

Remplacer_symboles_par_caractères 'remplace "Œ" par "OE", "..." par "etc.", "œ" par "oe"

' Sort
    Range("A1").Select 'Select top left corner
    Selection.End(xlDown).Select 'Search bottom row
    rownumber = ActiveCell.Row 'Remember bottom row
    'MsgBox "Bottom row = " & rownumber

    Range("A1").Select
    Selection.End(xlToRight).Select 'Search most right column
    colnumber = ActiveCell.Column
    'MsgBox "Most right column = " & colnumber

    Range(Cells(1, 1), Cells(rownumber, colnumber)).Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
        Key2:=Range("B2"), Order2:=xlAscending, _
        Key3:=Range("C2"), Order3:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
        
' Identify doubles
    n = 2
    While Range("A" & n) <> ""
        Range("A" & n).Select
        If (LCase(Range("A" & n) & Range("B" & n) & Range("C" & n) & Range("D" & n) & Range("E" & n)) = LCase(Range("A" & n - 1) & Range("B" & n - 1) & Range("C" & n - 1) & Range("D" & n - 1) & Range("E" & n - 1))) Then
            rownumber = ActiveCell.Row
            RRange = "A" & rownumber & ""
            Rows(rownumber & ":" & rownumber).Select
            Selection.Delete Shift:=xlUp
            Range(RRange).Select
            MsgBox "Un double est à éliminer à la rangée " & rownumber & "."
         End If
         n = n + 1
    Wend

' Copy without date in name to "My Data Sources"
    OldFn = ActiveWorkbook.Name
    FnRoot = Left(OldFn, Len(OldFn) - 11)
    ShortFn = FnRoot & ".xls"
    NewFn = FnRoot & "_" & Format(Date, "yymmdd") & ".xls" ': MsgBox "L'ancien fichier s'appelait " & OldFn & ", la racine en est " & ShortFn & " et le nouveau fichier s'appellera " & NewFn

'    MsgBox "Votre ordinateur s'appelle " & """" & Application.UserName & """."
    If Application.UserName = "Erik" Then
        DirDest = "D:\Web\Ulrike\"
        MailAd = Array("ulrike.vancotthem@gmail.com")
    End If
    
    If Application.UserName <> "Erik" Then
        DirDest = "C:\Documents and Settings\les amoureux\mes documents\mes kikis docs\mon site\tableau concerts\"
'        DirDest = "C:\"
        MailAd = Array("erik.vandyck@club-internet.fr")
    End If

'   Re-enable "EnableEvents" after the automatic actions above
    Application.EnableEvents = True

'   Save updates XLS-file
    On Error Resume Next
    MkDir DirDest & "Docs\"
    FN = DirDest & "docs\" & NewFn

    On Error Resume Next
    ActiveWorkbook.SaveAs FileName:=FN, ReadOnlyRecommended:=False, AddToMru:=True

    Application.DisplayAlerts = True

'   Send file by email
    On Error Resume Next
    Application.Dialogs(xlDialogSendMail).Show MailAd

    FN = FnRoot & ".XML"
    Make_XML DirDest, FN
    
    FN = FnRoot & ".HTML"
    Make_HTML DirDest, FN

'   Prepare uploading
    MsgBox "Téléchargez en un coup" & Chr(10) & Chr(10) & """" & FnRoot & ".XML""" & "  et" & Chr(10) & """" & FnRoot & ".HTML""" & Chr(10) & Chr(10) & "qui se trouvent tous les deux à  """ & DirDest & """"
    Open_IE DirDest, FN 'for uploading of XML- and HTML-file
    
'   Move files to appropriate directories
    If Application.UserName = "Erik" Then
        Kill DirDest & "XML\" & FnRoot & ".XML"
        Name DirDest & FnRoot & ".XML" As DirDest & "XML\" & FnRoot & ".XML"
        
        Kill DirDest & "Docs\" & FnRoot & ".HTML"
        Name DirDest & FnRoot & ".HTML" As DirDest & "Docs\" & FnRoot & ".HTML"
    End If

'    Application.Quit

End Sub
Sub Make_XML(Dir As String, FN As String)
'
' Make XML Macro
' Macro enregistrée le 04/04/2010 par Erik
'
    ExportToXML Dir & FN, "Concert" '=name of top level node in XML-file
'
End Sub
Public Function ExportToXML(FullPath As String, RowName _
  As String) As Boolean

On Error GoTo ErrorHandler

Dim r As Integer, colIndex As Integer, rwIndex As Integer, iFileNum As Integer
Dim c As Variant
Dim sName As String ', asCols() As String
Dim oWorkSheet As Worksheet
Dim lastCol As Long, lastRow As Long
Dim colList(7) As Integer
colList(0) = 6 '  6 = ville
colList(1) = 7 '  7 = lieu
colList(2) = 8 '  8 = prog
colList(3) = 9 '  9 = mus
colList(4) = 12 '12 = DateTimeText
colList(5) = 13 '13 = DateText
colList(6) = 14 '14 = HeureText
colList(7) = 15 '15 = DateTimeTextPeremption

Set oWorkSheet = ThisWorkbook.Worksheets(1)
sName = oWorkSheet.Name

Range("A1").Select 'Select top left corner
Selection.End(xlDown).Select 'Search bottom row
lastRow = ActiveCell.Row ':MsgBox "Bottom row = " & lastRow 'Remember bottom row


Range("A1").Select
Selection.End(xlToRight).Select 'Search most right column
lastCol = ActiveCell.Column ':MsgBox "Most right column = " & lastCol

iFileNum = FreeFile
Open FullPath For Output As #iFileNum

Print #iFileNum, "<?xml version=""1.0""  encoding=""ISO-8859-1""?>"
Print #iFileNum, "<" & sName & " Date=""" & Format(Now, "dd/mm/yyyy hh:mm") & """>"

For r = 2 To lastRow
Print #iFileNum, "<" & RowName & ">"
  
    For Each c In colList
        Cells(r, c).Select
        If c < 12 Then 'protège les colonnes calculées par des formules formatées
            If Trim(Cells(r, c).Value) = "" Then
                Cells(r, c).Value = " "
                Else
                Cells(r, c).Value = Trim(Cells(r, c).Value)
            End If
        End If
        Select Case c
            Case 13: Print #iFileNum, "  <" & Cells(1, c).Value & ">" & Format(Cells(r, c).Value, "dd/mm/yy") & "</" & Cells(1, c).Value & ">" 'en format de date normalisé
            Case 14: Print #iFileNum, "  <" & Cells(1, c).Value & ">" & Format(Cells(r, c).Value, "hh:mm") & "</" & Cells(1, c).Value & ">" 'en format de temps normalisé            Case Else: Print #iFileNum, "  <" & asCols(c - 1) & ">" & Cells(r, c).Value & "</" & asCols(c - 1) & ">" 'en format texte inchangé
            Case Else: Print #iFileNum, "  <" & Cells(1, c).Value & ">" & Cells(r, c).Value & "</" & Cells(1, c).Value & ">"
        End Select
    Next c

    Print #iFileNum, "</" & RowName & ">"
Next r

Print #iFileNum, "</" & sName & ">"
ExportToXML = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function
End Function

Sub Make_HTML(Dir As String, FN As String)
'
' Make HTML Macro
'
ExportToHTML Dir & FN
'
End Sub
Public Function ExportToHTML(FullPath As String) As Boolean

'PURPOSE: EXPORTS AN EXCEL SPREADSHEET TO HTML
'PARAMETERS: FullPath: Full Path of File to Export Sheet

'RETURNS: True if Successful, false otherwise

On Error GoTo ErrorHandler

Dim r As Integer, rr As Integer, lastRow As Integer, iFileNum As Integer, DateTimeTextCol As Integer
Dim toDay As String, firstConcert As String

Range("A1").Select 'Select top left corner
Selection.End(xlDown).Select 'Search bottom row
lastRow = ActiveCell.Row ':MsgBox "Bottomrow = " & lastRow 'Remember bottom row


DateTimeTextCol = 12
toDay = Format(Now, "yyyymmdd") ':MsgBox "toDay = " & toDay

'Seek first future concert
rr = 2
Do While Cells(rr, DateTimeTextCol).Value < toDay
    Cells(rr, DateTimeTextCol).Select 'Select top left corner
    rr = rr + 1
Loop
firstConcert = Cells(rr, DateTimeTextCol).Value ':MsgBox "firstConcert = " & firstConcert

iFileNum = FreeFile
Open FullPath For Output As #iFileNum

Print #iFileNum, "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">"
Print #iFileNum, "<html xmlns=""http://www.w3.org/1999/xhtml"">"
Print #iFileNum, "<head>"
Print #iFileNum, "<meta http-equiv=""Content-Type"" content=""text/html; charset=iso-8859-1"" />"
Print #iFileNum, "<title>Ulrike Van Cotthem: Prochains concerts pr&eacute;vus en date du " & Format(Now, "dd/mm/yyyy") & "</title>"
Print #iFileNum, "</head>"
Print #iFileNum, "<body>"
Print #iFileNum, "<table width=""100%"" border=""1"">"
Print #iFileNum, "<thead>"
Print #iFileNum, "<p style=""text-align:center;font-size:large;font-weight:bold"">Concerts chant&eacute;s par Ulrike Van Cotthem entre " & Format(Cells(rr, DateTimeTextCol + 1).Value, "dd/mm/yyyy") & " et " & Format(Cells(lastRow, DateTimeTextCol + 1).Value, "dd/mm/yyyy") & "</p>"
Print #iFileNum, "</thead>"
Print #iFileNum, "<tr>"
Print #iFileNum, "<th scope=""col"">Date</th>"
Print #iFileNum, "<th scope=""col"">Heure</th>"
Print #iFileNum, "<th scope=""col"">Ville</th>"
Print #iFileNum, "<th scope=""col"">Lieu</th>"
Print #iFileNum, "<th scope=""col"">Programme</th>"
Print #iFileNum, "<th scope=""col"">Musiciens</th>"
Print #iFileNum, "</tr>"

For r = rr To lastRow
    Cells(r, 13).Select 'visual tracer
        Print #iFileNum, "<tr>"
        Print #iFileNum, "<td>" & Cells(r, 13) & "</td>" 'date
        Print #iFileNum, "<td>" & Format(Cells(r, 14), "hh:mm") & "</td>" 'heure
        Print #iFileNum, "<td>" & Cells(r, 6) & "</td>" 'ville
        Print #iFileNum, "<td>" & Cells(r, 7) & "</td>" 'lieu
        Print #iFileNum, "<td>" & Cells(r, 8) & "</td>" 'programme
        Print #iFileNum, "<td>" & Cells(r, 9) & "</td>" 'musiciens
        Print #iFileNum, "</tr>"
Next r

Print #iFileNum, "</table>"
Print #iFileNum, "</body>"
Print #iFileNum, "</html>"

ExportToHTML = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function
End Function
Sub Open_IE(Dir As String, FN As String)
'
' Open_IE Macro
'
Dim objFSO As Object
Dim IE, inp As Object

Set IE = CreateObject("InternetExplorer.application")
IE.Navigate "http://www.clermont-herault-concerts.fr/Ulrike_van_Cotthem_File_Upload_1.php"
IE.Visible = True

Do
    DoEvents
Loop Until IE.ReadyState = 4

Set IE = Nothing

End Sub

<xsl:for-each select="Beds/*/*">
            <xsl:choose>
              <xsl:when test="contains(name(.),'Code')">
              </xsl:when>
              <xsl:otherwise>
                <Row>
                  <Category>BedDetails</Category>
                  <RoomName>
                    <xsl:value-of select="../../../RoomName"/>
                  </RoomName>
                  <Length/>
                  <Width/>
                  <Height/>
                  <Description>
                    <xsl:value-of select="name(..)"/>
                    <xsl:value-of select="name(.)"/>
                  </Description>
                  <Value>
                    <xsl:for-each select="../*">
                      <xsl:if test="contains(name(.),'Code')">
                        <xsl:value-of select="name(.)"/>
                      </xsl:if>
                    </xsl:for-each>
                  </Value>
                  <NoOfDays>0</NoOfDays>
                  <Quantity>
                    <xsl:value-of select="."/>
                  </Quantity>
                </Row>
              </xsl:otherwise>
              </xsl:choose>
          </xsl:for-each>

Neophyte30 wrote:

Can anyone point me toward the proper XPath expression to say "sibling that begins with the name of the current element [and ends with 'Code']"? I'd like to sidestep the if, if that's possible...

../*[name() = concat(name(current()), 'Base')]

<?xml version="1.0" encoding="UTF-8" ?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

   <xsl:output method="xml"/>
   
   <xsl:template match="/">
      <table>
         <!-- Iterate through all bed types and items -->
         <xsl:apply-templates select="Beds/*/*"/>
      </table>
   </xsl:template>

   <!-- Just process the odd items (1st, 3rd, 5th etc) for each bed type -->
   <xsl:template match="Beds/*/*[(position() mod 2) = 1]">
      <xsl:if test="text() and following-sibling::*[1]/text()">
      <Row>
         <!-- Description is the parent name + this node's name -->
         <Description><xsl:value-of select="concat(name(parent::node()), name())"/></Description>
         <!-- Value is just the next sibling node's text -->
         <Value><xsl:value-of select="following-sibling::*[1]/text()"/></Value>
         <!-- Quantity is this node's text -->
         <Quantity><xsl:value-of select="text()"/></Quantity>
      </Row>
   </xsl:if>
   </xsl:template>
   
   <!-- This template just sucks up the even items -->
   <xsl:template match="*"/>

</xsl:stylesheet>

<xsl:for-each select="Beds/*/*">
          <xsl:choose>
            <xsl:when test="not(contains(name(.),'Code')) and .&gt;0">
              <Row>
                <Description>
                  <xsl:value-of select="name(..)"/>
                  <xsl:value-of select="name(.)"/>
                </Description>
                <Value>
                  <xsl:value-of select="following-sibling::*[contains(name(),name(.))]"/>
                </Value>
                <Quantity>
                  <xsl:value-of select="."/>
                </Quantity>
              </Row>
            </xsl:when>
          </xsl:choose>
        </xsl:for-each>

XDocument doc = XDocument.Load(Server.MapPath(@"file.xml"));


     var temp = (from element in doc.Root.Elements("photo") where element.Attribute("filename").Value == txtBoxFileName.Text && element.Attribute("thumbnail").Value == txtBoxThumbname.Text && element.Attribute("description").Value == txtBoxDesc.Text select element);

          XElement result = null;

          if (temp.Count() == 0)
          {
              result = doc.Root.Elements().Last();
              result.AddAfterSelf(new XElement("photo", new XAttribute("filename", txtBoxFileName.Text), new XAttribute("thumbnail", txtBoxThumbname.Text), new XAttribute("description", txtBoxDesc.Text)));
              result = doc.Root.Elements().Last();
          }
          else
          {
              result = temp.First();
          }


          result.Add(new XElement("photo", new XAttribute("filename", txtBoxFileName.Text), new XAttribute("thumbnail", txtBoxThumbname.Text), new XAttribute("description", txtBoxDesc.Text)));

          doc.Save(Server.MapPath(@"file.xml"));
          this.lblxml.Text = "done";

result.AddAfterSelf( ... )
...
...
result.Add( ... );