完成途中
DsoFile.Dllはあまりにも多くのことがあるので、まずコードから
目標
Script Guyの記事の復元と解説
Script Guyの2010年の記事との比較
ASPのDeadLinkの復元
64 Bit VBAの関数化
64 bit で起動しない重要なものはJscriptだけではなくDsoFile.Dllもそうだった
Jscriptの配列ソートが利用できない件 http://qiita.com/Q11Q/items/cd18050fc53e97e83598 もひどい話だったが、さりげなくDsoFile.dllも使えない。32bit版は使える。
仮想化した場合の注意（2022/11/26追記）
デフォルトではC:\DSOfileにインストールされますが、デフォルトの位置に正しくインストールしても、32Bit VBScript
がCreateOjbectでエラーで止まる。VBA参照設定のときすぐ表示されない、参照ボタンを押してフォルダを開いて設定したが、変数を宣言してもファイルを読みこないという現象が生じる場合があります。
その場合はローカルとされる別のフォルダにインストールするとうまくいく場合があります。
仮想化しているCドライブは環境変数と実態が違うため、このようなことが起きていると考えられる。
DsoFile.Dllとは
まずダウンロードとインストールが必要
Microsoft Developer Support OLE File Property Reader 2.1 Sample (KB 224351)
WebArchiveからのダウンロードになります。
プロパティの読み込み
特にOffice、さらにWord,Excel,Powerpointの情報をファイルを開くことなくゲットできる。このためパスワードがかかっていてもゲットできる。
現在はbuitinpropertiesなどを使ったりする。古くはExcel4Macroだった。
特にこのDsofileは最終更新日と最終印刷日が保持され、これは読むことしかできない。このため、更新日が本当はいつなのか、これで判断することができる。
しかもこれをファイルを開くことなく取得できる。
その他、Word向け、PowerPoint向けの機能がある。
語られていないProperty
公式は書いていないが、これは全部で30あるが、29しか述べられていない。
それはDocumentSecurity(Long)である。
CustumPropertyの書き込み
自分で作ったプロパティを書き込める。
しかしこれは今回取り扱っていない。
ただし独自に設定したプロパティは読む。
語られていない機能 アイコンのプロパティ
どこにも書いていないが、Iconのプロパティを読める。
今回はこれが読めるようにした。
語られていない機能 サムネイルのプロパティのプロパティ
これはサムネイルを掴めないため、今のところ不明な機能である。
語られていない機能 Oleファイルかどうか
実はPDFファイル、MSGファイルもちょっと読めたりする。大したことはない。しかしテキストファイルは3つしか読めない。OLEファイルではないからだ。
32Bitだと動く
VBADSOfile
Sub VBADsofile()
' https://docs.microsoft.com/ja-jp/previous-versions/tn-archive/ee692828(v=technet.10)#EFAA
' Win 10 Excel 2013 32Bit Available
' You should Have to get DSOFile.dll and Install Your Windows PC. (XP ... Win 10 OK)
Dim oDSO: Set oDSO = CreateObject("DSOFile.OleDocumentProperties")
'参照設定
'Dim oDSO As DSOFile.OleDocumentProperties
'Set oDSO = New DSOFile.OleDocumentProperties
Dim buf
Dim cnt
Dim iObj
Dim oThum
Dim strFileFullPath
On Error Resume Next
strFileFullPath = "E:\test.xlsm"
oDSO.Open strFileFullPath
With oDSO.SummaryProperties
buf = buf & Chr(34) & "ApplicationName" & Chr(34) & "," & Chr(34) & .ApplicationName & Chr(34) & vbCrLf
buf = buf & Chr(34) & "RevisionNumber" & Chr(34) & "," & Chr(34) & .RevisionNumber & Chr(34) & vbCrLf
buf = buf & Chr(34) & "TotalEditTime" & Chr(34) & "," & Chr(34) & .TotalEditTime & Chr(34) & vbCrLf
buf = buf & Chr(34) & "SharedDocument(bool)" & Chr(34) & "," & Chr(34) & .SharedDocument & Chr(34) & vbCrLf
buf = buf & Chr(34) & "DocumentSecurity(Long)" & Chr(34) & "," & Chr(34) & .DocumentSecurity & Chr(34) & vbCrLf 'Hidden Property
buf = buf & Chr(34) & "Template" & Chr(34) & "," & Chr(34) & .Version & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Version" & Chr(34) & "," & Chr(34) & .Template & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Author" & Chr(34) & "," & Chr(34) & .Author & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Company" & Chr(34) & "," & Chr(34) & .Company & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Manager" & Chr(34) & "," & Chr(34) & .Manager & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Title" & Chr(34) & "," & Chr(34) & .Title & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Subject" & Chr(34) & "," & Chr(34) & .Subject & Chr(34) & vbCrLf
buf = buf & Chr(34) & "ByteCount" & Chr(34) & "," & Chr(34) & .ByteCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Keywords" & Chr(34) & "," & Chr(34) & .Keywords & Chr(34) & vbCrLf
buf = buf & Chr(34) & "MultimediaClipCount" & Chr(34) & "," & Chr(34) & .MultimediaClipCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "NoteCount" & Chr(34) & "," & Chr(34) & .NoteCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "DateCreated" & Chr(34) & "," & Chr(34) & .DateCreated & Chr(34) & vbCrLf
buf = buf & Chr(34) & "DateLastPrinted" & Chr(34) & "," & Chr(34) & .DateLastPrinted & Chr(34) & vbCrLf
buf = buf & Chr(34) & "DateLastSaved" & Chr(34) & "," & Chr(34) & .DateLastSaved & Chr(34) & vbCrLf
buf = buf & Chr(34) & "LastSavedBy" & Chr(34) & "," & Chr(34) & .LastSavedBy & Chr(34) & vbCrLf
''Word
buf = buf & Chr(34) & "CharacterCount" & Chr(34) & "," & Chr(34) & .CharacterCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "CharacterCountWithSpaces" & Chr(34) & "," & Chr(34) & .CharacterCountWithSpaces & Chr(34) & vbCrLf
buf = buf & Chr(34) & "PageCount" & Chr(34) & "," & Chr(34) & .PageCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "LineCount" & Chr(34) & "," & Chr(34) & .LineCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "ParagraphCount" & Chr(34) & "," & Chr(34) & .ParagraphCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Comments" & Chr(34) & "," & Chr(34) & .Comments & Chr(34) & vbCrLf
''PowerPoint
buf = buf & Chr(34) & "PresentationFormat" & Chr(34) & "," & Chr(34) & .PresentationFormat & Chr(34) & vbCrLf
buf = buf & Chr(34) & "SlideCount" & Chr(34) & "," & Chr(34) & .SlideCount & Chr(34) & vbCrLf
buf = buf & Chr(34) & "HiddenSlideCount" & Chr(34) & "," & Chr(34) & .HiddenSlideCount & Chr(34) & vbCrLf
'''File Properties
buf = buf & Chr(34) & "Path" & Chr(34) & "," & Chr(34) & oDSO.Path & Chr(34) & vbCrLf
buf = buf & Chr(34) & "name" & Chr(34) & "," & Chr(34) & oDSO.Name & Chr(34) & vbCrLf
buf = buf & Chr(34) & "CLSID" & Chr(34) & "," & Chr(34) & oDSO.CLSID & Chr(34) & vbCrLf
buf = buf & Chr(34) & "ProgID" & Chr(34) & "," & Chr(34) & oDSO.progID & Chr(34) & vbCrLf
buf = buf & Chr(34) & "IsOleFile" & Chr(34) & "," & Chr(34) & oDSO.IsOleFile & Chr(34) & vbCrLf
buf = buf & Chr(34) & "OleDocumentType" & Chr(34) & "," & Chr(34) & oDSO.OleDocumentType & Chr(34) & vbCrLf
buf = buf & Chr(34) & "IsReadOnly" & Chr(34) & "," & Chr(34) & oDSO.IsReadOnly & Chr(34) & vbCrLf
buf = buf & Chr(34) & "IsDirty" & Chr(34) & "," & Chr(34) & oDSO.IsDirty & Chr(34) & vbCrLf
buf = buf & Chr(34) & "OleDocumentFormat" & Chr(34) & "," & Chr(34) & oDSO.OleDocumentFormat & Chr(34) & vbCrLf
''' ICON Properties
Set iObj = oDSO.Icon
buf = buf & Chr(34) & "Icon.Handle" & Chr(34) & "," & Chr(34) & iObj.Handle & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Icon.Height" & Chr(34) & "," & Chr(34) & iObj.Height & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Icon.Width" & Chr(34) & "," & Chr(34) & iObj.Width & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Icon.Type" & Chr(34) & "," & Chr(34) & iObj.Type & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Icon.OLE_HANDLE" & Chr(34) & "," & Chr(34) & iObj.OLE_HANDLE & Chr(34) & vbCrLf
'This is No test
Set oThum = oDSO.SummaryProperties.Thumbnail
If Not oThum Is Empty Then
buf = buf & Chr(34) & "Thunail.Handle" & Chr(34) & "," & Chr(34) & oThum.Handle & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Thunail.Height" & Chr(34) & "," & Chr(34) & oThum.Height & Chr(34) & vbCrLf
buf = buf & Chr(34) & "Thunail.Width" & Chr(34) & "," & Chr(34) & oThum.Width & Chr(34) & vbCrLf
End If
End With
ar = Split(buf, vbCrLf)
If UBound(ar) > 0 Then
For cnt = 0 To UBound(ar)
Debug.Print ar(cnt)
Next
End If
With oDSO.CustomProperties
If .Count > 0 Then
For cnt = 1 To .Count
buf = buf & Chr(34) & .Item(i).Name & "," & .Item(i).Type & "," & .Item(i).Value & vbCrLf
Next
End If
End With
Debug.Print buf
End Sub
64bitはVBAからVBSを32Bitで起動し、ファイルのフルパスを渡して、クリップボードからデータを受け取る。
VBS側
D:\getDSOProp.vbsとする
getDSOProp.vbs
'-----------------------------------
'DSOfile.Dllは32 bit でしか動かないため、32bit強制起動する必要があります。
'ただしVBS側で強制起動しているとClipにデータが受け渡せないので、VBA側で32Bitで起動する必要があります。
'-----------------------------------
Option Explicit
Const dsoOptionDefault = 0
Const dsoOptionDontAutoCreate = 4
' https://social.msdn.microsoft.com/Forums/vstudio/en-US/bb3bb690-66c3-4a55-85a9-fb87bac6081c/detecting-file-type-in-vba-for-word?forum=worddev
' or you can add dsoOptionOnlyOpenOLEFiles to the options and
' use error trapping to detect -2147217148
Const dsoOptionOnlyOpenOLEFiles = 1
Const dsoOptionOpenReadOnlyIfNoWriteAccess = 2
Const dsoOptionUseMBCStringsForNewSets = 8
'DSOFile.dsoFilePropertyType のメンバー
Const dsoPropertyTypeBool = 4
Const dsoPropertyTypeDate = 5
Const dsoPropertyTypeDouble = 3
Const dsoPropertyTypeLong = 2
Const dsoPropertyTypeString = 1
Const dsoPropertyTypeUnknown = 0
Dim strFileFullPath
Dim objArgs,RetArgs
Set objArgs= Wscript.Arguments
With CreateObject("Scripting.FileSystemObject")
IF objArgs.Count > 0 And .FileExists(objArgs(0))=False Then Wscript.Quit
End With
Dim oDSO 'As DSOFile.OleDocumentProperties
Set oDSO = Createobject("DSOFile.OleDocumentProperties")
Dim buf
Dim cnt
Dim iObj
Dim oThums,oThum
Dim ar
Dim i
On Error Resume Next
strFileFullPath =objArgs(0) 'RetArgs 'objArgs(0) '"C:\User\Name\wordfile.docx"
oDSO.Open strFileFullPath 'Open(sFileName As String, [ReadOnly As Boolean = False], [Options As dsoFileOpenOptions = dsoOptionDefault])
If oDSO.IsOle = True Then
With oDSO.SummaryProperties
buf = RpDqtc(strFileFullPath) & Rpdqtccr("is Ole File Show list")
buf = buf & RpDqtc("ApplicationName") & "," & RpdqtccR( .ApplicationName)
buf = buf & RpDqtc("RevisionNumber") & RpdqtccR( .RevisionNumber)
buf = buf & RpDqtc("TotalEditTime(Long)") & RpdqtccR(.TotalEditTime)
buf = buf & RpDqtc("SharedDocument(bool)") & RpDqtccR( .SharedDocument)
buf = buf & RpDqtc("DocumentSecurity(Long)") & RpDqtccR( .DocumentSecurity) 'Hidden Property
buf = buf & RpDqtc("Version") & RpdqtccR( .Version)
buf = buf & RpDqtc("Template") & RpdqtccR( .Template)
buf = buf & RpDqtc("Author") & RpdqtccR( .Author)
buf = buf & RpDqtc("Company(String){Get,Set}") & RpDqtccR(.Company)
buf = buf & RpDqtc("Manager(String){Get,Set}") & RpDqtccR( .Manager)
buf = buf & RpDqtc("Title(String){Get,Set}") & RpdqtccR( .Title)
buf = buf & RpDqtc("Subject(String){Get,Set}") & RpdqtccR( .Subject)
buf = buf & RpDqtc("ByteCount") & RpdqtccR( .ByteCount)
buf = buf & RpDqtc("Keywords(String){Get,Set}") & RpdqtccR( .Keywords)
buf = buf & RpDqtc("Category(String){Get,Set}") & RpdqtccR( .Category)
buf = buf & RpDqtc("MultimediaClipCount") & RpdqtccR( .MultimediaClipCount)
buf = buf & RpDqtc("NoteCount") & RpdqtccR( .NoteCount)
buf = buf & RpDqtc("DateCreated(variant)") & RpdqtccR( fDT(.DateCreated))
buf = buf & RpDqtc("DateLastPrinted(variant)") & RpdqtccR( fDT(.DateLastPrinted))
buf = buf & RpDqtc("DateLastSaved(variant)") & RpdqtccR(fDT(.DateLastSaved))
buf = buf & RpDqtc("LastSavedBy") & RpdqtccR( .LastSavedBy)
''Word
buf = buf & RpDqtc("CharacterCount") & RpdqtccR( .CharacterCount)
buf = buf & RpDqtc("CharacterCountWithSpaces") & RpdqtccR( .CharacterCountWithSpaces)
buf = buf & RpDqtc("PageCount") & RpdqtccR( .PageCount)
buf = buf & RpDqtc("LineCount") & RpdqtccR( .LineCount)
buf = buf & RpDqtc("ParagraphCount") & RpdqtccR( .ParagraphCount)
buf = buf & RpDqtc("Comments(String){Get,Set}") & RpdqccR( .Comments)
''PowerPoint
buf = buf & RpDqtc("PresentationFormat") & RpdqtccR( .PresentationFormat)
buf = buf & RpDqtc("SlideCount") & RpdqtccR( .SlideCount)
buf = buf & RpDqtc("HiddenSlideCount") & RpdqtccR( .HiddenSlideCount)
'''File Properties
buf = buf & RpDqtc("Path") & RpdqtccR( oDSO.Path)
buf = buf & RpDqtc("name") & RpdqtccR( oDSO.Name)
buf = buf & RpDqtc("LSID") & RpdqtccR( oDSO.CLSID)
buf = buf & RpDqtc("ProgID") & RpdqtccR( oDSO.progID)
buf = buf & RpDqtc("IsOleFile") & RpdqtccR( oDSO.IsOleFile)
buf = buf & RpDqtc("OleDocumentType") & RpdqtccR( oDSO.OleDocumentType)
buf = buf & RpDqtc("IsReadOnly") & Rpdqtr( oDSO.IsReadOnly)
buf = buf & RpDqtc("IsDirty") & Rpdqtr( oDSO.IsDirty )
buf = buf & RpDqtc("OleDocumentFormat") & Rpdqt( oDSO.OleDocumentFormat )
''' ICON Properties
Set iObj = oDSO.Icon
buf = buf & RpDqtc("Icon.Handle") & Rpdqtccr( iObj.Handle)
buf = buf & RpDqtc("Icon.Height") & Rpdqtccr( iObj.Height)
buf = buf & RpDqtc("Icon.Width") & Rpdqtccr( iObj.Width)
buf = buf & RpDqtc("Icon.Type") & Rpdqcctr( iObj.Type )
buf = buf & RpDqtc("Icon.OLE_HANDLE") & Rpdqtccr( iObj.OLE_HANDLE )
'This is No test
Set oThum = oDSO.SummaryProperties.Thumbnail
If Not oThum Is Empty Then
buf = buf & RpDqtc("Thunail.Handle")& RpdqtccR( oThum.Handle)
buf = buf & RpDqtc("Thunail.Height") & RpDqtccR(oThum.Height)
buf = buf & RpDqtc("Thunail.Width") & RpDqtccR(oThum.Width)
End If
End With
Else
buf = RpDqtc(strFileFullPath) & Rpdqtccr("Not OLE File. So 3 Informaiton Return")
buf = buf & RpDqtc("IsOleFile") & Rpdqtccr( oDSO.IsOleFile)
buf = buf & RpDqtc("IsReadOnly") & Rpdqtccr( oDSO.IsReadOnly)
buf = buf & RpDqtc("IsDirty") & Rpdqtccr( oDSO.IsDirty )
End If ' IF oDSO.IsOleFile
ar = Split(buf, vbCrLf)
If UBound(ar) > 0 Then
For cnt = 0 To UBound(ar)
'WScript.Echo ar(cnt)
Next
End If
With oDSO.CustomProperties
If .Count > 0 Then
For cnt = 1 To .Count
buf = buf & Chr(34) & RpDqtc(.Item(i).Name) & RpDqtc(.Item(i).Type) & RpDqtR(.Item(i).Value)
Next
End If
End With
'CreateObject("WScript.Shell").Exec "cmd /c clip.exe < """ & buf & """" ' Failed : https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10172981370
'Clipと書くからと言ってClipを省略するとうまくいかない
CreateObject("WScript.Shell").Exec("Clip").StdIn.Write buf
'WScript.Echo buf
oDSO.Close False 'Close([SaveBeforeClose As Boolean = False])
Set oDSO = Nothing
Set objArgs=Nothing
WScrpt.Quit
Function RpDqt(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog"
' Rapping with DoubleQuTation
RpDqt=chr(34) & varString & chr(34)
End Function
Function RpDqtc(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog" ,
' Rapping with DoubleQuoTation
'RpDqtc=chr(34) & varString & chr(34) & ","
RpDqtc=chr(34) & varString & chr(34) & chr(44)
End Function
Function RpDqtR(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog" & VbCrLf
' Rapping with DoubleQuoTation
RpDqR=chr(34) & varString & chr(34) & VbCrLf
End Function
Function RpDqtccR(varString) ' As String
' String Return With DoubleQuotation Such As
' Dog => "Dog" , "","" & VbCrLf
' Rapping with DoubleQuoTation
RpDqtccR=chr(34) & varString & chr(34) & "," & """""" & "," & """""" & VbCrLf
End Function
Function fDT(Var)
If var Is vbNull Then fDT="" : Exit Function
If var = vbNullChar Then fDT = "" : Exit Function
IF var Is vbEmpty Then fDT="" : Exit Function
If var = vbNullString Then fDT= "" : Exit Function
fDT(Var)=CDate(var)
End Function
Function fBL(Var)
fBL(Var)=CBool(Var)
End Function
### VBA側
参照設定
Microsoft Forms 2.0 (C:\Windows\System32\FM20.dll)
Windows Script Host Object Model
ここがポイント
C:\Windows\SysWOW64\Cmd.Exe
C:\Windows\SysWOW64\wscript.exe
ここで意図的に32Bitで指定する。
いままでVBS側はあったが、VBA側で行う。そうしないと最初のプロセスと別になるため、Clipボードが取得できないためである。
VBS側でダブルクォーテーションラッピング関数、ダブルクォーテーションラッピングコンマ関数、ダブルクォーテーションvbCrLf関数を作り、かなり見やすくなった。
カスタムプロパティと平仄を合わせているため、このままCSVにしても大丈夫になっている。
また配列で返るため指定したプロパティを取り出すとよい。
Sub Dsotest()
Const VBSPath As String = "D:\getDSOProp.vbs" 'VBSCriptのフルパスを指定
Dim strFilePath As String
Dim ret
Dim arsub, brprop, wEXEC As Long, sCMD As String, wsh As IWshRuntimeLibrary.WshShell
Dim dataObj As DataObject
Dim i1 As Long, j1 As Long
strFilePath = "D:\Database.MDB"
Set dataObj = New DataObject
dataObj.Clear: DoEvents
Set wsh = New IWshRuntimeLibrary.WshShell
sCMD = "C:\Windows\SysWOW64\Cmd.Exe /c " & """C:\Windows\SysWOW64\wscript.exe //nologo """ & VBSPath & """ """ & strFilePath & """ """ & " | Clip """
'Debug.Print sCMD: DoEvents
'sCMD = VBSPath & """" & strFilePath & """ | Clip "
' 1にして成功したときの0でLoopさせるとうまくいくようだ
wEXEC = 1: DoEvents
wEXEC = wsh.Run("C:\Windows\SysWOW64\wscript.exe //nologo //T:3000 " & VBSPath & " " & strFilePath & " | Clip ", 0, True)
Do Until wEXEC = 0
DoEvents
dataObj.GetFromClipboard: DoEvents
Loop
wEXEC = 1: DoEvents '時間稼ぎ
Set wsh = Nothing: DoEvents '時間稼ぎ
dataObj.GetFromClipboard: DoEvents
arsub = Split(dataObj.GetText, vbCrLf)
For i1 = LBound(arsub) To UBound(arsub)
Debug.Print arsub(i1)
Next
End Sub
同じく上記のVBSを活用して、VBAでSubプロシージャから、関数を呼び出して返すパターン
Sub functionretDsoFilePropTest()
Dim ar, strFilePath As String
strFilePath = "D:\test.MDB" 'ファイルのフルパスを指定
'配列で返ってくる
ar = retDsofileProperty(strFilePath)
End Sub
Function retDsofileProperty(strFilePath)
Const VBSPath As String = "D:\getDSOProp.vbs"
Dim ArSub, brprop, wEXEC As Long, sCMD As String, wsh As IWshRuntimeLibrary.WshShell
Dim dataObj As DataObject
Dim i As Long
Dim i1 As Long, BrSub
Set dataObj = New DataObject
dataObj.Clear: DoEvents
Set wsh = New IWshRuntimeLibrary.WshShell
wEXEC = 100: DoEvents
If CreateObject("Scripting.filesystemObject").FileExists(strFilePath) Then
wEXEC = wsh.Run("C:\Windows\SysWOW64\wscript.exe //nologo //T:3000 " & VBSPath & " " & strFilePath & " | Clip ", 0, True)
Do Until wEXEC = 0
DoEvents
Loop
wEXEC = 1: DoEvents '時間稼ぎ
Set wsh = Nothing: DoEvents '時間稼ぎ
Do Until wsh Is Nothing
DoEvents
Loop
dataObj.GetFromClipboard: DoEvents
ArSub = Split(dataObj.GetText, vbCrLf)
If UBound(ArSub) <= 4 Then 'Txtファイルは4つしかとれないがIsOleFileはとれる。これを利用して取得したか確認する。通常のファイルなら4つというのは確実に失敗
For i = LBound(ArSub) To UBound(ArSub)
On Error Resume Next
BrSub = Split(ArSub, ",")
If Err.Number <> 0 Then
retDsofileProperty (strFilePath) 'Splitに失敗するならエラー、やりなおし。
End If
If BrSub = Empty Then retDsofileProperty (strFilePath) 'Emptyなら、やりなおし。
On Error GoTo 0
For i1 = LBound(BrSub) To UBound(BrSub)
If BrSub(i1) = "IsOleFile" Then
retDsofileProperty = ArSub
Exit Function
End If
Next
Next
Else
'4より大きいならとれているので値を返して解放
Set dataObj = Nothing
retDsofileProperty = ArSub
Exit Function
End If
End If
retDsofileProperty = 0
End Function
参考文献
VBAで配列を引数・戻り値にする方法
コピーされたセル範囲を取得する方法のサンプルソース
VBAで他のアプリケーションを同期起動する（WshShell）
MS-DOSコマンドの標準出力を取得する
WScript.exe および CScript.exe のオプション
田中先生はProcessIDを取得するが、シンプルな方法を今回は取っている。
◆こんなソフトウェアつくってください!～Part2～◆
2003年ごろの2chはまだ夢があったなあ。
ACT1:ファイル一覧を取得して、ファイルのプロパティとともに表示してみる。 DeadLink復元予定
HOME > 即効テクニック > Excel VBA > その他関連のテクニック > クリップボードとデータのやりとりをする
4VBAからVBSに要素数不定の配列の引数を引き渡す方法
配列のクリップボード転送(VBAHaskell)
VBAで配列を引数・戻り値にする方法
他のプログラムの終了を待つには
VBSがわで32Bit起動するとこの方法も通用しない。幸い今回は成功値を待つという方法にしている。
VBS function にて設定した配列を返すには、どうすれば良いですか？
Excel VBAで○○をやる方法まとめ
ここのコードは誤り、GetObjectは開いてしまう。またExcelの話なのにSampeはWord。またDSOFileにはHyperLinkの起点はないと思う。
Private Function get_page_cnt_word(sFile As String, sPath As String) As Long 'ページ数の取得を行う関数（Word) '引数：処理対象のファイル名、処理対象ファイルの格納フォルダ Dim wdDoc As Object 'オブジェクトを取得 Set wdDoc = GetObject(sPath & "\" & sFile) 'ページ数を取得 get_page_cnt_word = wdDoc.BuiltinDocumentProperties(14).Value 'オブジェクト変数を解放 Set wdDoc = Nothig End Function
https://qiita.com/nukie_53/items/12cc0a3fc295a446a045
DocsOffice VBA ReferenceLanguage referenceReferenceFunctionsGetObject
Document.BuiltInDocumentProperties プロパティ (Word)
Document.CustomDocumentProperties プロパティ (Word)
Home » エクセルマクロ・Excel VBAの使い方 » ユーザー定義関数 »ファイルの最終更新日時を取得したい
これもExcelの ThisWorkbook.BuiltinDocumentProperties("Last save time").Value
を使用したもの。開いている。