Public Sub test()
    Dim XMLDoc As Object
    Dim bParse, xmlE, currNode
    
    Set XMLDoc = CreateObject("MSXML2.DOMDocument")
    'Отключаем асинхронную загрузку
    'xmlParser.async = False
    bParse = XMLDoc.Load(ThisWorkbook.Path & "\Output.xml")
    If Not bParse Then
        Debug.Print "Ошибка парсинга файла- " & XMLDoc.parseError.reason
    Else
    
    'Запускаем рекурсию с корневого элемента (нулевой уровень)
    ParseNode XMLDoc.DocumentElement, 0
    
    End If
    'Освобождаем объектную переменную
    Set XMLDoc = Nothing
End Sub
'******************************************************************************
Function ParseNode(nodeNode, numLevel)
    
    Dim nodeAttr, nodeChild
    
    'Выводим имя узла, а также его значение, если оно есть
    If Not IsNull(nodeNode.NodeValue) Then
        Debug.Print Space(numLevel * 2) & nodeNode.nodeName & " = " & _
                     Trim(nodeNode.NodeValue)
    Else
        Debug.Print Space(numLevel * 2) & nodeNode.nodeName
    End If
    'Выводим атрибуты узла, если они есть
    If Not nodeNode.Attributes Is Nothing Then
        For Each nodeAttr In nodeNode.Attributes
            Debug.Print Space((numLevel + 1) * 2) & nodeAttr.nodeName & _
                         " = " & nodeAttr.NodeValue
        Next
    End If
    'Выводим рекурсивно дочерние узлы, если они есть
    If nodeNode.ChildNodes.Length > 0 Then
        For Each nodeChild In nodeNode.ChildNodes
            ParseNode nodeChild, numLevel + 1
        Next
    End If
    
End Function

Sub Test() 
  ' Place some settings in the registry.
  SaveSetting "MyApp", "Startup", "Top", 75
  SaveSetting "MyApp", "Startup", "Left", 50
   
  ' Read settings from registry
  Debug.Print GetSetting(appname:="MyApp", section:="Startup", Key:="Top", Default:="10")
  Debug.Print GetSetting(appname:="MyApp", section:="Startup", Key:="Left", Default:="25")
   
  DeleteSetting "MyApp", "Startup" 
End Sub

 Dim ii As String
 ii = InputBox("Введите текст", "Окно ввода текста", "F:\MyBD\")
 ThisWorkbook.Worksheets(1).Cells(1, 1) = ii
 ThisWorkbook.Save