Click here to Skip to main content
14,427,367 members
   

XML / XSL

 
GeneralRe: XSD and Elements Order Pin
MrKBA18-Jul-10 3:57
MemberMrKBA18-Jul-10 3:57 
QuestionSearching for multiple types with XPath Pin
Trollslayer10-Jul-10 1:45
mentorTrollslayer10-Jul-10 1:45 
AnswerRe: Searching for multiple types with XPath Pin
Not Active10-Jul-10 8:06
mentorNot Active10-Jul-10 8:06 
AnswerRe: Searching for multiple types with XPath Pin
sameerazazi877-Aug-10 3:07
Membersameerazazi877-Aug-10 3:07 
QuestionXpath problem Pin
snehasish9-Jul-10 1:27
Membersnehasish9-Jul-10 1:27 
AnswerRe: Xpath problem Pin
Stuart Dootson9-Jul-10 12:12
professionalStuart Dootson9-Jul-10 12:12 
QuestionExcel to XML conversion Pin
priyaahh5-Jul-10 19:49
Memberpriyaahh5-Jul-10 19:49 
AnswerRe: Excel to XML conversion Pin
evd4610-Aug-10 21:13
Memberevd4610-Aug-10 21:13 
Hi Priya,

I'm developping a website for an befriended artist. I've put her concerts and repertoire in two Excel files - easy for her to update - and added one single macro to them that runs several tasks in a row:
- sort the data
- search for duplicates
- rename the files with a date-code (YYMMDD) in the name, what helps for backing-up the data
- convert the data first into XML-format and then into an HTML-table that can be forwarded to people who might be interested in printing the data
- open an form in IE that uploads the files in XML and HTML-formats directly to the server of her website.
As far as I'm aware, I didn't encounter your type of problem.

For your info and hopefully your help, I add the lengthy code hereunder:

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

Questionxsl:apply-templates help please! [modified] Pin
Neophyte301-Jul-10 5:49
MemberNeophyte301-Jul-10 5:49 
AnswerRe: xsl:apply-templates help please! Pin
Neophyte305-Jul-10 1:17
MemberNeophyte305-Jul-10 1:17 
GeneralRe: xsl:apply-templates help please! Pin
Stuart Dootson6-Jul-10 5:37
professionalStuart Dootson6-Jul-10 5:37 
AnswerRe: xsl:apply-templates help please! Pin
Stuart Dootson6-Jul-10 5:14
professionalStuart Dootson6-Jul-10 5:14 
GeneralRe: xsl:apply-templates help please! Pin
Neophyte306-Jul-10 6:47
MemberNeophyte306-Jul-10 6:47 
GeneralRe: xsl:apply-templates help please! Pin
Stuart Dootson6-Jul-10 15:38
professionalStuart Dootson6-Jul-10 15:38 
QuestionHow to upload an Xml Schema to my ftp server and have Visual Studio provide intellisense for it? Pin
WebMaster1-Jul-10 3:07
MemberWebMaster1-Jul-10 3:07 
AnswerRe: How to upload an Xml Schema to my ftp server and have Visual Studio provide intellisense for it? Pin
Not Active1-Jul-10 3:38
mentorNot Active1-Jul-10 3:38 
GeneralRe: How to upload an Xml Schema to my ftp server and have Visual Studio provide intellisense for it? Pin
WebMaster1-Jul-10 4:11
MemberWebMaster1-Jul-10 4:11 
Questiontransformed cdata content not escaping properly (or atleast the way i want it it) Pin
nyhtal30-Jun-10 20:59
Membernyhtal30-Jun-10 20:59 
QuestionVXML Pin
muka6629-Jun-10 5:15
Membermuka6629-Jun-10 5:15 
QuestionHow to create xmpp client using C#? Pin
manjeeet18-Jun-10 0:13
Membermanjeeet18-Jun-10 0:13 
Answercross-post Pin
Luc Pattyn18-Jun-10 3:27
sitebuilderLuc Pattyn18-Jun-10 3:27 
QuestionError in running ASP.NET C# (MySql) site Pin
Dot-Net-Dev16-Jun-10 18:24
MemberDot-Net-Dev16-Jun-10 18:24 
QuestionBeginner help to tag Bold text in DocBook v5 for XML export [modified] Pin
keeta116-Jun-10 13:06
Memberkeeta116-Jun-10 13:06 
QuestionWrite XSL for this xml i want to convert xml to CSV formt Pin
ksanju100012-Jun-10 10:14
Memberksanju100012-Jun-10 10:14 
AnswerRe: Write XSL for this xml i want to convert xml to CSV formt Pin
SeMartens15-Jun-10 22:10
MemberSeMartens15-Jun-10 22:10 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.