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