Outlook Publisherはこの機能がないらしい
PowerpointとPublisherは似ているのですが、ここが全く違います。
必ず下記の参照設定が必要です
Microsoft Visual Basic for Applications Extensibility X.X
現在は5.3のようです。
これをしないと動きません。
またWordは
Microsoft Scripting Runtimeも参照設定しています。
Wordで使っているのはダブルクォーテーションで包み、コンマまたは改行を付加する関数です。
https://qiita.com/Q11Q/items/0c956f9bbdb7efee56f0
Powerpoint
Sub ExoirtPowerpointaRefsettings()
'Powerpointの参照設定を出力する
Dim pp As PowerPoint.Presentation: Set pp = ActivePresentation
Dim VP As VBProject
Dim ref As Reference, refs As References
Set VP = Application.VBE.ActiveVBProject
Set refs = VP.References
For Each ref In refs
Debug.Print ref.Name
Next
End Sub
Word
Sub ExportWordVBARefs()
'FilesystemObjectは参照設定
'出力先は
Const ExportFileFullPath = "D:\wdList.txt"
Dim wd As Word.Document: Set wd = ThisDocument
Dim refs As VBIDE.References, ref As VBIDE.Reference
Dim Ts As TextStream, FSO As New Scripting.FileSystemObject
Set Ts = FSO.OpenTextFile(ExportFileFullPath, ForAppending, True)
Set refs = Application.VBE.ActiveVBProject.References
For Each ref In refs
On Error Resume Next
If ref.IsBroken = False Then
Ts.Write RpDqtc(ref.Name) & RpDqtc(ref.Major) & RpDqtc(ref.Minor) & RpDqtc(ref.Description) & RpDqtc(ref.FullPath) & RpDqtc(ref.GUID) & RpDqR(ref.Type)
Else
Ts.Write RpDqtc(ref.Name) & RpDqtc("Broken") & "" & "" & vbCrLf
End If
If Err.Number <> 0 Then Debug.Print ref.Name, Err.Number, Err.Description: Err.Clear
Next
Ts.Close
End Sub
Function RpDqtc(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog" ,
' wRapping with DoubleQuoTation
'RpDqtc=chr(34) & varString & chr(34) & ","
On Error Resume Next
If TypeName(varString) = "Date" Then
RpDqtc = Chr(34) & CDate(varString) & Chr(34) & Chr(44)
Else
RpDqtc = Chr(34) & CStr(varString) & Chr(34) & Chr(44)
End If
Exit Function
On Error GoTo 0
If Err.Number <> 0 Then
Err.Clear
RpDqtc = Chr(34) & Chr(34) & Chr(44)
Exit Function
End If
End Function
Function RpDqR(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog" & VbCrLf
' wRapping with DoubleQuoTation
On Error Resume Next
If TypeName(varString) = "Date" Then
RpDqR = Chr(34) & CDate(varString) & Chr(34) & vbCrLf
Else
RpDqR = Chr(34) & CStr(varString) & Chr(34) & vbCrLf
End If
Exit Function
On Error GoTo 0
If Err.Number <> 0 Then
'Wscript.Echo Err.Number, Err.Description
Err.Clear
RpDqR = Chr(34) & Chr(34) & vbCrLf: Exit Function
End If
End Function