Исходный код

Option Explicit
Call CreateSheet()


'=====================================================================
' Создать таблицу, содержащую объекты рабочего стола, и вывести ее в MSExcel
'=====================================================================
Sub CreateSheet()
  Dim sheet, ExcelApp, ExSheet, n

  'Создать виртуальную таблицу и добавить в нее все объекты,
  'лежащие на рабочем столе
  Set sheet = ThisApplication.CreateSheet
  sheet.Add ThisApplication.Desktop.Objects

  'Если таблица непустая, вывести результат в Excel
  If sheet.Objects.Count > 0 Then
      ' Запустить MSExcel
      Set ExcelApp = CreateObject("Excel.Application")

      ' Добавить рабочую книгу, озаглавить первые два столбца
      ExcelApp.Workbooks.Add
      Set ExSheet = ExcelApp.ActiveSheet
      ExSheet.Cells(1, 1) = "Тип объекта"
      ExSheet.Cells(1, 2) = "Описание объекта"
      ExSheet.Rows(1).Font.Bold = True

      ' Вывод полученной таблицы
      For n = 0 To sheet.RowsCount - 1 
          ExSheet.Cells(n+2, 1) = sheet.RowValue(n).ObjectDef.Description
          ExSheet.Cells(n+2, 2) = sheet.RowValue(n).Description
      Next

      'Отформатировать и показать лист Excel
      ExSheet.Columns.AutoFit
      ExcelApp.Application.Visible = True 
      Set ExcelApp = Nothing
  Else
      MsgBox "Нет данных для создания таблицы.", vbInformation, "Ошибка"
  End If
  Set sheet = Nothing
End Sub 
'=====================================================================