Code Snippets



Public objDOMDocument As MSXML2.DOMDocument60 

'***********************************************************************************
Public Sub XML_Connect()
   Set objDOMDocument = New MSXML2.DOMDocument60
   objDOMDocument.Load (sFULLPATH)
End Sub
'***********************************************************************************
Public Sub DisplayData()
Dim lfundcount As Long
Dim sfundgroup As String
Dim sfundgroup_previous As String
Dim sfundname As String

   On Error GoTo AnError
   For lfundcount = 0 To objDOMDocument.documentElement.childNodes.Length - 1
      sfundgroup = objDOMDocument.documentElement.childNodes(lfundcount).childNodes(0).Text
      If sfundgroup <> sfundgroup_previous Then
         frmLoanTradeReport.lsbFundsList.AddItem "Group " & sfundgroup
      End If
      sfundgroup_previous = sfundgroup
   Next lfundcount
   Exit Sub

AnError:

End Sub
'***********************************************************************************
Public Function FundsInGroup(ByVal sGroupName As String, _
                    Optional ByVal bReturnFirstFund As Boolean = False) As String
Dim lfundcount As Long
Dim sFundConCat As String
Dim sfundgroup As String
Dim sfundname As String

   On Error GoTo AnError
   For lfundcount = 0 To objDOMDocument.documentElement.childNodes.Length - 1
      sfundgroup = objDOMDocument.documentElement.childNodes(lfundcount).childNodes(0).Text
      sfundname = objDOMDocument.documentElement.childNodes(lfundcount).childNodes(1).Text
      If sfundgroup = sGroupName Then
         sFundConCat = sFundConCat & sfundname & ";"
         If bReturnFirstFund = True Then Exit For
      End If
   Next lfundcount
   
   FundsInGroup = Left(sFundConCat, Len(sFundConCat) - 1)
   Exit Function

AnError:

End Function
'***********************************************************************************
Public Sub ExportFundList()

   Call ExportToXML(sFULLPATH, "Fund")
   
End Sub
'***********************************************************************************
Public Function ExportToXML(ByVal FullPath As String, _
                            ByVal RowName As String) As Boolean

On Error GoTo AnError

Dim colIndex As Integer
Dim rwIndex As Integer
Dim asCols() As String
Dim oWorkSheet As Worksheet
Dim sName As String
Dim lCols As Long, lRows As Long
Dim iFileNum As Integer
Dim i As Long
Dim j As Long

   Set oWorkSheet = ThisWorkbook.Worksheets(1)
   sName = oWorkSheet.Name
   lCols = oWorkSheet.Columns.Count
   lRows = oWorkSheet.Rows.Count
   
   ReDim asCols(lCols) As String
   
   iFileNum = FreeFile
   Open FullPath For Output As #iFileNum
   
   For i = 0 To lCols - 1
'Assumes no blank column names
       If Trim(Cells(1, i + 1).Value) = "" Then Exit For
       asCols(i) = Cells(1, i + 1).Value
   Next i
   
   If i = 0 Then GoTo AnError
   lCols = i
      
   Print #iFileNum, "<?xml version=""1.0""?>"
   
   Print #iFileNum, "<FundList>"
   
   For i = 2 To lRows
   If Trim(Cells(i, 1).Value) = "" Then Exit For
   Print #iFileNum, "<" & RowName & ">"
     
       For j = 1 To lCols
           
           If Trim(Cells(i, j).Value) <> "" Then
              Print #iFileNum, " <" & asCols(j - 1) & ">" & Trim(Cells(i, j).Value) & "</" & asCols(j - 1) & ">"
           End If
       Next j
       Print #iFileNum, "</" & RowName & ">"
   Next i
   
   Print #iFileNum, "</FundList>"
   
   ExportToXML = True
   
AnError:
   If iFileNum > 0 Then Close #iFileNum

End Function
'***********************************************************************************


© 2020 Better Solutions Limited. All Rights Reserved. © 2020 Better Solutions Limited TopPrev