Записать информацию в новый текстовый файл и открыть его программой по умолчанию

On Error Resume Next 'на случай, если в CD-приводе нет диска
Dim fs, dr, ndr, d, d1, drv, s
Set fs = CreateObject("Scripting.FileSystemObject") 
Set dr = fs.Drives 
ndr = dr.Count
d = "Всего дисков - " & ndr & ": "
For Each d1 in dr
name_d = d1.DriveLetter & ":" 
d = d & name_d & " "
Set drv = fs.GetDrive(fs.GetDriveName(name_d))
s = s & vbLF & "Имя диска " & drv.Path & " - " 
s = s & drv.VolumeName
Select Case drv.DriveType
Case 0: t = "Неизвестный"
Case 1: t = "Удаляемый (флэш и пр.)"
Case 2: t = "Раздел винчестера"
Case 3: t = "Сетевой"
Case 4: t = "CD-ROM" 
Case 5: t = "RAM диск"
End Select
s = s & ", тип " & t & vbLF
s = s & "Серийный номер диска " & _ 
drv.SerialNumber & vbLF
s = s & "Серийный номер диска " & _ 
drv.SerialNumber & vbLF
s = s & "Всего: " & _
FormatNumber(drv.TotalSize/1024/1024, 0)
s = s & " Мб,"
s = s & " свободно: " & _
FormatNumber(drv.FreeSpace/1024/1024, 0)
s = s & " Мб" & vbLf
Next
s = d & vbLf & s
MsgBox s,, "Свойства файла"

Option Explicit
'декларация функции
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

''''твой код
    MsgBox s, , "Свойства файла"
    
    Open App.Path & "\info.txt" For Output As 1 ' рядом с программой
        Print #1, s' запись в файл
    Close 1
    
    ShellExecute 0, vbNullString, App.Path & "\info.txt", vbNullString, vbNullString, vbNormalFocus

CreateObject("WScript.Shell").Run App.Path & "\info.txt"