In support of this post
https://excelfox.com/forum/showthrea...5355#post15355
_____ Workbook: Sample excel file.xls ( Using Excel 2007 32 bit )
Worksheet: Sheet1
Row\Col A B C D E F G H I 1 Entity ID day month year time <-- row number 2 3 4 5 6 7 <-- column number 8 9 Lr=5 10 arrIn()=Range("A1:E5").Value 1 2 11 Entity ID day month year time 12 13 14 15 16 17 Example: arrIn(5, 1) = 701
text file output
HTML Code:<forecast> <Entity>700</Entity> <data> <date> <day>19/<day> <month>2</month> <year>2021</year> </date> <time>08:00</time> <time>08:30</time> </data> <data> <date> <day>20/<day> <month>2</month> <year>2021</year> </date> <time>09:00</time> </data> </forcast> <forecast> <Entity>701</Entity> <data> <date> <day>19/<day> <month>2</month> <year>2021</year> </date> <time>09:30</time> </data> </forcast>Code:Option Explicit ' Sub ExcelToXML() Rem 1 worksheets data info Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1) Dim Lr As Long: Let Lr = Ws1.Range("A" & Rows.Count & "").End(xlUp).Row Dim arrRng() As Variant: Let arrRng() = Ws1.Range("A1:E" & Lr + 1 & "").Value ' +1 is a bodge to help me not get errors when checking 1 row above my data Rem 2 Do it Dim TotalFile As String Dim Rw As Long: Let Rw = 2 ' Main row count ' #STEP 1 Start Do While Rw <= Lr ' This keeps us going as long as data is there Let TotalFile = TotalFile & "<forecast>" & vbCr & vbLf & "<Entity>" & arrRng(Rw, 1) & "</Entity>" & vbCr & vbLf: Debug.Print TotalFile ' # STEP 2 start Let TotalFile = TotalFile & "<data>" & vbCr & vbLf & "<date>" & vbCr & vbLf & "<day>" & arrRng(Rw, 2) & "/<day>" & vbCr & vbLf & "<month>" & arrRng(Rw, 3) & "</month>" & vbCr & vbLf & "<year>" & arrRng(Rw, 4) & "</year>" & vbCr & vbLf & "</date>" & vbCr & vbLf & "<time>" & Format(arrRng(Rw, 5), "hh" & ":" & "mm") & "</time>" & vbCr & vbLf: Debug.Print TotalFile ' #STEP 3 START ' Check if Entity ID in first row = Entity ID in 2nd row and date in first row = date in 2nd row then repeat STEP 3 for 2nd row and so on Do While Rw + 1 <= Lr And arrRng(Rw, 1) = arrRng(Rw + 1, 1) And arrRng(Rw, 2) = arrRng(Rw + 1, 2) Let TotalFile = TotalFile & "<time>" & Format(arrRng(Rw + 1, 5), "hh" & ":" & "mm") & "</time>" & vbCr & vbLf: Debug.Print TotalFile Let Rw = Rw + 1 ' This brings us to the line we just filled in Loop Let TotalFile = TotalFile & "</data>" & vbCr & vbLf: Debug.Print TotalFile ' Chect if Entity ID in first row = Entity ID in 2nd row and date in first row not equals to date in 2nd row then repeat STEP 2 for 2nd row and so on Do While Rw + 1 <= Lr And arrRng(Rw, 1) = arrRng(Rw + 1, 1) ' And Not arrRng(Rw, 2) = arrRng(Rw + 1, 2) Let TotalFile = TotalFile & "<data>" & vbCr & vbLf & "<date>" & vbCr & vbLf & "<day>" & arrRng(Rw + 1, 2) & "/<day>" & vbCr & vbLf & "<month>" & arrRng(Rw + 1, 3) & "</month>" & vbCr & vbLf & "<year>" & arrRng(Rw + 1, 4) & "</year>" & vbCr & vbLf & "</date>" & vbCr & vbLf & "<time>" & Format(arrRng(Rw + 1, 5), "hh" & ":" & "mm") & "</time>" & vbCr & vbLf: Debug.Print TotalFile Let Rw = Rw + 1 ' This brings us to the line we just filled in Loop Let TotalFile = TotalFile & "</data>" & vbCr & vbLf: Debug.Print TotalFile ' #STEP 3 END ' STEP 2 END Let TotalFile = TotalFile & "</forcast>" & vbCr & vbLf: Debug.Print TotalFile Let Rw = Rw + 1 ' ' This brings us to the next line ' STEP 1 END Loop ' While Rw <= Lr Let TotalFile = Replace(TotalFile, "</data>" & vbCr & vbLf & "</data>" & vbCr & vbLf, "</data>" & vbCr & vbLf, 1, -1, vbBinaryCompare): Debug.Print TotalFile ' I end up with a double "</data>" & vbCr & vbLf Rem 3 Make text file Dim FileNum2 As Long: Let FileNum2 = FreeFile(0) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Dim PathAndFileName2 As String Let PathAndFileName2 = ThisWorkbook.Path & "\" & "XML_Stuff.txt" ' ' CHANGE TO SUIT ' Will be made if not there Open PathAndFileName2 For Output As #FileNum2 Print #FileNum2, TotalFile ' write out entire text file Close #FileNum2 End Sub ' <forecast> ' #STEP 1 Start Print #intFile, "<Forecast>" ' <Entity>700</Entity> ' #STEP 1 Start Print #intFile, "<Entity>" & Entity ID & "</Entity>" ' <data> ' #STEP 2 Start Print #intFile, "<Data>" ' <date> ' #STEP 2 Start Print #intFile, "<date>" ' <day>19</day> ' #STEP 2 Start Print #intFile, "<day>" & day & ' <month>2</month> ' #STEP 2 Start "</day><month>" & month & "</month> ' <year>2021</year> ' #STEP 2 Start <year>" & yeear & "</year>" ' </date> ' #STEP 2 Start </date>" ' <time>8:00</time> ' #STEP 3 START Print #intFile, "<time>" & time & "</time>" ' Check if Entity ID in first row = Entity ID in 2nd row ' and date in first row = date in 2nd row then ' <time>8:30</time> ' repeat STEP 3 for 2nd row and so on ' </data> ' #STEP 3 END ' Check if Entity ID in first row = Entity ID in 2nd row ' and date in first row IS NOT = date in 2nd row then' ' repeat STEP ??3?? 2 for 2nd row and so on ' <data> ' <date> ' <day>20</day> ' <month>2</month> ' <year>2021</year> ' </date> ' <time> ??8:00?? 9.00 </time> ' </data> ' </forecast> ' STEP 2 END Print #intFile, "</forecast>" ' If Entity ID is not same as in previous row repeat STEP 1 ' ' <forecast> ' <Entity>701</Entity> ' <data> ' <date> ' <day>19</day> ' <month>2</month> ' <year>2021</year> ' </date> ' <time>9:30</time> ' </data> ' </forecast> ' <forecast>
Reply With Quote
Bookmarks