Cocoa AppleScript ファイルから UTI 取得 Open/Saveダイアログの改良 AppleScript [06]
AppleScript [06] Cocoa AppleScript 第2版 ファイルから UTI 取得、Open/Save ファイルダイアログの改良!
Macの OpenFile 選択用ダイアログは 拡張子ではなく厳密には UTI指定 ( 4 UTIまで動作確認済み)のため、 xlsx や xlsm など拡張子指定が無効な時あり →常にUTI指定すれば問題なし!
ファイルから UTI (Uniform Type Identifier) 取得は簡単なので、調査用の Vanilla AS ハンドラーを追加して、VBAから呼び出し可能に!
VBAの SaveFileName 用ダイアログも Macでは 拡張子指定できないため、指定拡張子以外を選んだ場合は再度ダイアログを表示する等 Open/Save ファイルダイアログを 改良!
(注) AppleScript にて、フォルダ選択ダイアログ あるいは ファイル選択ダイアログ を利用します!
2021/09/26 Ver. 3.1「Cocoa AppleScript 第2版」に改良!
→ AppleScript は "filePath.scpt" ファイル内のコード全て「差し替え」、VBAコードは「追加(一部は差し替え)」となります。(インターフェースの追加と、コメントやサンプルコードの修正)
2021/11/07 "UniformTypeIdentifiers" 新フレームワークの利用方法が判明!
→ macOS11[Big Sur]以降限定となるが、use framework "UniformTypeIdentifiers" の UTType クラスにて...
コメント(3つめ)に、Cocoa AppleScript (ASOC) 拡張子 or MIME から UTI を取得するサンプルコードを掲載。
【AppleScriptの差し替え】 AppleScript [06] Cocoa AppleScript 第2版 ファイルから UTI 取得、Open/Save ファイルダイアログの改良!
まず、Excel メニューバーの [ヘルプ] - [更新プログラムのチェック] にて、適用されていないアップデートがあれば行ってください。
VBA の AppleScriptTask コマンド パラメータの注意点
ファイルパスと区別するため フォルダパス指定には 末尾に必ず / を付加 してください! フォルダフルパス なら 先頭と末尾が必ず / となります。
OneDrive や iCloud、Dropbox、Box 等のサービスをブラウザ利用でなくフォルダにリンクしている場合も(リンク)パスが判れば指定可能ですが、https:// が先頭に付いたり ネットワーク経由のアクセスのためとんでも無く時間がかかりますので ローカルPC(Mac本体内の高速なSSDやHDDドライブ)上のフォルダパスを指定してください。
第2版 Cocoa AppleScript コードの全置換(一部はVanilla AS記述)
(1) 以前に 作成したExcelファイルをマクロを有効にして開き、続いて VBEウィンドウ を開く。
(2) ~/ライブラリ/Application Scripts/com.microsoft.Excel/ フォルダ内に保存した filePath.scpt をダブルクリック等で("スクリプトエディタ"アプリにて)開き、 ファイル内の全AppleScriptコードを以下のコードで置換し、 コンパイル後に ファイルを保存 したら "スクリプトエディタ"アプリは終了してください。
上記の操作方法がよく解らない方は、 以前の投稿 をお読みください。
VBA、AppleScript 両方のコードに コメントをたくさん記述しておいたので、宜しければ ご覧ください!
2021/09/26 Ver. 3.1「Cocoa AppleScript 第2版」に改良!
→ AppleScript は "filePath.scpt" ファイル内のコード全て「差し替え」、VBAコードは「追加(一部は差し替え)」となります。(インターフェースの追加と、コメントやサンプルコードの修正)
全置換となるため 以下の全AppleScriptコードを コピー&ペースト(貼り付け)後、 コンパイル後に ファイルを保存 してください。 VBAコード に関しては「次章」に記載します。
書くのを忘れていましたが、 AppleScript 40行目の「 property HIDDEN_FILES : true 」の true を fasle に置換して コンパイル後に ファイルを保存 すると、フォルダ階層(子フォルダ)に対応したパスやファイル名を返す AppleScriptTask の場合、 隠しファイルも表示 されるようになります。 確認後は、 true に戻すことをオススメします!
AppleScript "filePath.scpt" をダウンロード可能にしました。 Download Here
( ダウンロードしてダブルクリックすると、 "スクリプトエディタ.app" を起動! )
上記リンクを右クリックして「リンク先のファイルをダウンロード」等を選択してダウンロード可能。
( "Google Chrome" ブラウザの場合、上記リンクを右クリックして「名前を付けてリンク先を保存」を選択してダウンロード )
(注) [ Unicode(UTF-8) 、改行コードは LF ] ファイル置き場として、筆者の旧ブログを利用
ちなみに、 ret で始まる AppleScript の ハンドラー (VBAのプロシージャ相当の呼び出し単位)は Cocoa AS で主処理が実装されていますので、カスタマイズは慎重にお願いします。 その他の ハンドラー も Cocoa AS 実装の部分が判るように記述 しています。(何も記述が無ければ、Vannila AS ということ) Vanilla AS 部分はカスタマイズが楽で「 AppleScriptTask コマンド経由の呼び出し」ではなく、「 filePath.scpt をダブルクリック後に起動される スクリプトエディタ.app にて実行」すれば( Vanilla AS 部分の場合 )エラー発生箇所が判ります。 先頭部分の on test() から end test 内にサンプルのデバッグ用コードを記述済みのため、変更後に [command]+[K] でコンパイル、 test() の実行は [command]+[R] で可能です。 動作に問題が無い場合は [command]+[S] にて保存を忘れないように!
VBA だけでなく AppleScript コードも テキスト保存が可能なため、変更前に [command]+[A] にて全選択後 [command]+[C] でコピー してテキストエディタ等に [command]+[V] にてペースト(貼り付け)しておけば元に戻せます。 カスタマイズ作業前に filePath.scpt と AppleScriptTaskコマンドを記述したExcelファイル を ローカルPC上か クラウド領域にバックアップしておくと なお良いでしょう。
【VBA I/F追加】 AppleScript [06] Cocoa AppleScript 第2版 ファイルから UTI 取得、Open/Save ファイルダイアログの改良!
VBAコード の追加のため、末尾に 以降のコードを順番にコピー&ペースト(貼り付け)
ただし、(追加前 末尾の) Sub test31() と Sub test32() は「差し替え」のため、一度削除してください!
Sub test31()
'「単一」ファイル選択ダイアログで、フルパスを取得(拡張子限定あり)
' パラメータ[1] プロンプト文字列:""なら、AppleScriptコード設定の初期値
' パラメータ[2] 初期表示フォルダ:""なら、無指定(前回と同じフォルダを開く)
' POSIXフルパス指定のため、先頭と末尾に / が必要 ex) "/Users/username/Downloads/"
' パラメータ[3〜n]ファイル拡張子:"css" "html"のように 複数限定可(厳密だと、UTIを4つまで)
' 厳密には「拡張子ではなくUTI限定」のため、無効だと全ファイルが選択可能となる!
' 注. list(0) 「ディレクトリの(POSIX)フルパス」を格納
' list(1) 「ファイル名(拡張子あり)」を格納
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
Dim list() As String ' 「フルパス」格納用として「文字列の配列」を定義
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "単一ファイル選択!" & vbLf & "/Users/username/" & vbLf & LCase("css")
'getUtiByDialog() にて調べた xlsx , xlsm 対応のUTIをセットして、他のUTIを持つファイルを除外
scriptParam = "" & vbLf & "" & vbLf & "org.openxmlformats.spreadsheetml.sheet" & _
vbLf & "org.openxmlformats.spreadsheetml.sheet.macroenabled"
scriptResult = AppleScriptTask("filePath.scpt", "getFilePath", scriptParam)
If scriptResult <> "" Then '「キャンセル」ボタン押下時も、空文字列が返る
list = Split(scriptResult, vbLf) 'vbLf = Chr(10) 区切り文字に LF を利用
Call DispArray(list) '実行結果(文字列)の表示
Erase list '配列の初期化
Call GetClipBoard 'クリップボードに格納したテキストデータを取得&表示
End If
End Sub
Sub test32()
'「複数」ファイル選択ダイアログで、フルパスを取得(拡張子限定あり)
' パラメータ[1] プロンプト文字列:""なら、AppleScriptコード設定の初期値
' パラメータ[2] 初期表示フォルダ:""なら、無指定(前回と同じフォルダを開く)
' POSIXフルパス指定のため、先頭と末尾に / が必要 ex) "/Users/username/Downloads/"
' パラメータ[3〜n]ファイル拡張子:"css" "html"のように 複数限定可(厳密だと、UTIを4つまで)
' 厳密には「拡張子ではなくUTI限定」のため、無効だと全ファイルが選択可能となる!
' 注. list(0) 「ディレクトリの(POSIX)フルパス」を格納
' list(1〜n) 「ファイル名(拡張子あり)」を格納
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
Dim list() As String ' 「フルパス」格納用として「文字列の配列」を定義
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "複数ファイル選択!" & vbLf & "/Users/username/" & vbLf & LCase("css")
'getUtiByDialog() にて調べた xlsx , xlsm 対応のUTIをセットして、他のUTIを持つファイルを除外
scriptParam = "" & vbLf & "" & vbLf & "org.openxmlformats.spreadsheetml.sheet" & _
vbLf & "org.openxmlformats.spreadsheetml.sheet.macroenabled"
scriptResult = AppleScriptTask("filePath.scpt", "getMultiFilePath", scriptParam)
If scriptResult <> "" Then '「キャンセル」ボタン押下時も、空文字列が返る
list = Split(scriptResult, vbLf) 'vbLf = Chr(10) 区切り文字に LF を利用
Call DispArray(list) '実行結果(文字列)の表示
Erase list '配列の初期化
Call GetClipBoard 'クリップボードに格納したテキストデータを取得&表示
End If
End Sub
Sub test31() と Sub test32() は差し替えとなります! 呼び出される AppleScriptハンドラー のコードは変更していませんが、VBAサンプルコードを 拡張子から UTI セットに変更しました。
末尾の getUtiByDialog() 関数を利用すれば、ファイルに対応する UTI(Uniform Type Identifier) を調査可能。 Mac上で作成したファイルであれば確実に UTI がセットされるため、ファイル選択ダイアログで「利用したい拡張子を持つ」同ファイルを選択すること。
Sub test32() は複数ファイル選択ダイアログで、選択順の配列が返されるようです。 (2つ目以降のファイル選択は、[shift]+[クリック]にて!)
Sub test33()
'「単一」フォルダ選択ダイアログで、フォルダのフルパスを取得
' パラメータ[1] プロンプト文字列:""なら、AppleScriptコード設定の初期値
' パラメータ[2] 初期表示フォルダ:""なら、無指定(前回と同じフォルダを開く)
' POSIXフルパス指定のため、先頭と末尾に / が必要 ex) "/Users/username/Downloads/"
' 注. scriptResult 「ディレクトリの(POSIX)フルパス」を格納
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "単一フォルダ選択!" & vbLf & "/Users/username/"
scriptParam = "" & vbLf & ""
scriptResult = AppleScriptTask("filePath.scpt", "getFolderPath", scriptParam)
Debug.Print scriptResult
End Sub
Sub test34()
'「複数」フォルダ選択ダイアログで、フォルダのフルパスを取得
' パラメータ[1] プロンプト文字列:""なら、AppleScriptコード設定の初期値
' パラメータ[2] 初期表示フォルダ:""なら、無指定(前回と同じフォルダを開く)
' POSIXフルパス指定のため、先頭と末尾に / が必要 ex) "/Users/username/Downloads/"
' 注. list(0〜n) 「ディレクトリの(POSIX)フルパス」を格納
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
Dim list() As String ' 「フルパス」格納用として「文字列の配列」を定義
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "複数フォルダ選択!" & vbLf & "/Users/username/"
scriptParam = "" & vbLf & ""
scriptResult = AppleScriptTask("filePath.scpt", "getMultiFolderPath", scriptParam)
If scriptResult <> "" Then '「キャンセル」ボタン押下時も、空文字列が返る
list = Split(scriptResult, vbLf) 'vbLf = Chr(10) 区切り文字に LF を利用
Call DispArray(list) '実行結果(文字列)の表示
Erase list '配列の初期化
Call GetClipBoard 'クリップボードに格納したテキストデータを取得&表示
End If
End Sub
Sub test33() と Sub test34() は「単一」又は「複数」フォルダ選択ダイアログで、フォルダフルパスを返す。
'ファイル存在チェック(引数のパスが有効で、ファイルパスかどうか?)
'引数 path ( / から始まる)絶対パス
'結果 ""「パスが無効 もしくは フォルダパス」 又は(拡張子を含めた)ファイル名
Function MAC_FileExists(path As String) As String
On Error GoTo myError
MAC_FileExists = "" '「関数の結果」を初期化
Dim scriptResult As String ' AppleScript 実行結果 (文字列)
Dim scriptParam As String ' AppleScript パラメータ(文字列)
' AppleScriptを実行
' scriptParam = "/Users/username/Desktop/fileName.ext"
scriptParam = path
scriptResult = AppleScriptTask("filePath.scpt", "checkFilePath", scriptParam)
MAC_FileExists = scriptResult '「関数の結果」←「(拡張子を含めた)ファイル名」
Exit Function
myError:
MsgBox "エラー発生!(MAC_FileExists)"
End Function
'フォルダ存在チェック(引数のパスが有効で、フォルダパスかどうか?)
'引数 path ( / から始まる)絶対パス
'結果 ""「パスが無効 もしくは ファイルパス」 又は POSIX FolderPath
' 「(有効な)POSIX FolderPath」として、末尾に"/"を付加したパスを返す
Function MAC_FolderExists(path As String) As String
On Error GoTo myError
MAC_FolderExists = "" '「関数の結果」を初期化
Dim scriptResult As String ' AppleScript 実行結果 (文字列)
Dim scriptParam As String ' AppleScript パラメータ(文字列)
' AppleScriptを実行
' scriptParam = "/Users/username/Desktop/"
scriptParam = path
scriptResult = AppleScriptTask("filePath.scpt", "checkDirPath", scriptParam)
If scriptResult <> "" Then '(注) scriptResult は「(末尾の)フォルダ名」を格納
If Right(path, 1) = "/" Then 'パスの末尾が "/"
MAC_FolderExists = path
Else
MAC_FolderExists = path & "/" '「末尾に"/"を付加したPOSIX path」を返す
End If
End If
Exit Function
myError:
MsgBox "エラー発生!(MAC_FolderExists)"
End Function
MAC_FileExists(filePath) 関数はファイルが存在すれば「(フォルダ部分を除いた)ファイル名」を返し、MAC_FolderExists(folderPath) 関数はフォルダが存在すれば「(前後に / を付加した)POSIXフォルダフルパス」を返す。
'Macで"FileFilter"パラメータを措定すると、エラー!
'パラメータの MultiSelect は指定可能だが、無効で 2021/09/26現在 複数選択できない
' Application.GetOpenFilename を利用せず、 AppleScriptで 代替
' パラメーター utiList は、UTIの配列
Function MAC_GetOpenFilename(utiList As Variant) As String '単一選択
On Error GoTo myError
MAC_GetOpenFilename = ""
Dim filePath As String
Dim utiListStr As String
utiListStr = Join(utiList, vbLf) '配列の要素ごとに vbLf を挿入した文字列
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "単一ファイル選択!" & vbLf & "/Users/username/" & vbLf & LCase("xml")
'getUtiByDialog() にて調べた xlsx , xlsm 対応のUTIをセットして、他のUTIを持つファイルを除外
scriptParam = "" & vbLf & "" & vbLf & utiListStr
scriptResult = AppleScriptTask("filePath.scpt", "getFilePath", scriptParam)
If scriptResult <> "" Then '「キャンセル」ボタン押下時も、空文字列が返る
MAC_GetOpenFilename = scriptResult
End If
Exit Function
myError:
MsgBox "エラー発生!(MAC_GetOpenFilename)"
MAC_GetOpenFilename = "" '「関数の結果」を初期化
End Function
Sub sample_MAC_GetOpenFilename()
On Error GoTo myError
Dim filePath As String
Dim utiList(2) As String '拡張子に対応する「UTI」を2つ指定する場合 [getUtiByDialogでUTI調査]
utiList(0) = "org.openxmlformats.spreadsheetml.sheet" 'UTI for ".xlsx"
utiList(1) = "org.openxmlformats.spreadsheetml.sheet.macroenabled" 'UTI for ".xlsm"
filePath = ""
' 「指定したUTIを持つファイル」のみ単一選択可能なダイアログを表示
filePath = MAC_GetOpenFilename(utiList)
If filePath = "" Then 'ダイアログで「キャンセル」した場合、何も行わない
MsgBox "「キャンセル」又は「取得失敗」!" & vbLf & "( MAC_GetOpenFilename )"
Exit Sub
End If
Dim list() As String '「文字列の配列」を定義
list = Split(filePath, vbLf)
filePath = list(0) & list(1)
MsgBox filePath
Exit Sub '以下、サンプル操作を実行しない(サンプル実行なら、この行を削除かコメント化)
' 以下、サンプル操作
Dim wb As Workbook
Dim fileNameExt As String
fileNameExt = MAC_FileExists(filePath) 'ファイルが存在する場合、ファイル名が返る
If fileNameExt = "" Then 'ダイアログで filePath を取得したため、filePath 通常 有効なはず
MsgBox filePath & vbCrLf & "は、存在しません", vbExclamation
Exit Sub
End If
For Each wb In Workbooks
If wb.Name = fileNameExt Then '同名ブックを既に開いているか?
MsgBox filePath & vbCrLf & "は、既に開いています!", vbExclamation
Exit Sub
End If
Next wb
Workbooks.Open FileName:=filePath
Exit Sub
myError:
Application.DisplayAlerts = True '確認画面を表示するように 設定を戻す
MsgBox "エラー発生!(sample_MAC_GetOpenFilename)"
End Sub
MacのVBAで利用可能な OpenFilename ダイアログは FileFilter パラメータを指定できず MultiSelect パラメータも無効なため、Vanilla AS で代替。 「UTI配列指定」で間接的に「拡張子指定」を実現。
sample_MAC_GetOpenFilename() プロシージャは、MAC_GetOpenFilename() 関数を呼び出すためのサンプルコード。
'Macで"FileFilter"パラメータを措定すると、エラー!
'パラメータの MultiSelect は指定可能だが、無効で 2021/09/26現在 複数選択できない
' Application.GetOpenFilename を利用せず、 AppleScriptで 代替
' パラメーター utiList は、UTIの配列
Function MAC_GetOpenFilenameMultiSelect(utiList As Variant) As String '複数選択
On Error GoTo myError
MAC_GetOpenFilenameMultiSelect = ""
Dim filePath As String
Dim utiListStr As String
utiListStr = Join(utiList, vbLf) '配列の要素ごとに vbLf を挿入した文字列
Dim scriptResult As String ' AppleScript 実行結果 (文字列)、区切り文字 LF
Dim scriptParam As String ' AppleScript パラメータ(文字列)、区切り文字 LF
' AppleScriptを実行 (最後のパラメータが AppleScript に渡される文字列)
' パラメータの区切り文字には、Macの改行コード(vbLf)を指定
' scriptParam = "単一ファイル選択!" & vbLf & "/Users/username/" & vbLf & LCase("xml")
'getUtiByDialog() にて調べた xlsx , xlsm 対応のUTIをセットして、他のUTIを持つファイルを除外
scriptParam = "" & vbLf & "" & vbLf & utiListStr
scriptResult = AppleScriptTask("filePath.scpt", "getMultiFilePath", scriptParam)
If scriptResult <> "" Then '「キャンセル」ボタン押下時も、空文字列が返る
MAC_GetOpenFilenameMultiSelect = scriptResult
End If
Exit Function
myError:
MsgBox "エラー発生!(MAC_GetOpenFilenameMultiSelect)"
MAC_GetOpenFilenameMultiSelect = "" '「関数の結果」を初期化
End Function
Sub sample_MAC_GetOpenFilenameMultiSelect()
On Error GoTo myError
Dim filePath As String
Dim utiList(2) As String '拡張子に対応する「UTI」を2つ指定する場合 [getUtiByDialogでUTI調査]
utiList(0) = "org.openxmlformats.spreadsheetml.sheet" 'UTI for ".xlsx"
utiList(1) = "org.openxmlformats.spreadsheetml.sheet.macroenabled" 'UTI for ".xlsm"
filePath = ""
' 「指定したUTIを持つファイル」のみ「複数」選択可能なダイアログを表示
filePath = MAC_GetOpenFilenameMultiSelect(utiList)
If filePath = "" Then 'ダイアログで「キャンセル」した場合、何も行わない
MsgBox "「キャンセル」又は「取得失敗」!" & vbLf & "( MAC_GetOpenFilenameMultiSelect )"
Exit Sub
End If
Dim list() As String 'ファイルフルパス格納用として、「文字列の配列」を定義
Dim i As Long
list = Split(filePath, vbLf) 'vbLf = Chr(10) 区切り文字に LF を利用
For i = LBound(list) To UBound(list)
MsgBox list(i) 'list(0):フォルダフルパス list(1〜n):ファイル名
Next i
Exit Sub '以下、サンプル操作を実行しない(サンプル実行なら、この行を削除かコメント化)
' 以下、サンプル操作 (省略)
Exit Sub
myError:
Application.DisplayAlerts = True '確認画面を表示するように 設定を戻す
MsgBox "エラー発生!(sample_MAC_GetOpenFilenameMultiSelect)"
End Sub
sample_MAC_GetOpenFilenameMultiSelect() プロシージャは、MAC_GetOpenFilenameMultiSelect() 関数を呼び出すためのサンプルコードで 複数選択可能。
'2021/09/26現在 Macで"FileFilter"パラメータを措定不可 → 指定した拡張子(配列)と異なる場合は""
' ex) Dim extList(2) As String '許可する「拡張子」を2つ指定する場合(もちろん、1つでも可)
' extList(0) = "xlsx"
' extList(1) = "xlsm"
' dim filePath as Variant : filePath = ""
' Do Until (filePath = False Or filePath <> "") '指定した拡張子(配列)のみ、許可
' filePath = MAC_GetSaveAsFilename("initialNoExtFileName", extList)
' Loop
Function MAC_GetSaveAsFilename(initialFileName As String, extList As Variant) As Variant
On Error GoTo myError
Dim filePath As Variant 'ダイアログで「キャンセル」した場合、Falseが返されるため Variant型
MAC_GetSaveAsFilename = "" '「関数の結果」を初期化
'Macで"FileFilter"パラメータ措定するとエラー(←拡張子のみで起動アプリは決まらない)
'(注)指定したパスのファイルが既に存在する場合、「置き換え」の警告ダイアログが表示される
filePath = Application.GetSaveAsFilename(initialFileName) '(拡張子無しの)表示ファイル名
If filePath = False Then
MAC_GetSaveAsFilename = filePath
Exit Function 'ダイアログで「キャンセル」した場合、Falseが返される
End If
Rem If MAC_FileExists(CStr(filePath)) <> "" Then
Rem Exit Function '既に存在する場合も""を返して、「上書き」させないようにする
Rem End If
'以降、指定した拡張子(配列)に含まれるかどうか?
Dim pos As Long
Dim fileExt As String '取得した拡張子
Dim ext As Variant 'As Stringだと、エラーとなる
pos = InStrRev(CStr(filePath), ".") '拡張子を取得するため、末尾から検索
If pos > 0 Then
fileExt = LCase(Mid(CStr(filePath), pos + 1))
Else
Exit Function '拡張子なし の場合、""を返す
End If
For Each ext In extList
If fileExt = ext Then '指定した拡張子(配列)に含まれるかどうか?
MAC_GetSaveAsFilename = filePath 'フルパスを「関数の結果」として返す
Exit For
End If
Next
Exit Function
myError:
MsgBox "エラー発生!(MAC_GetSaveAsFilename)"
MAC_GetSaveAsFilename = "" '「関数の結果」を初期化
End Function
Sub sample_MAC_GetSaveAsFilename()
On Error GoTo myError
Dim filePath As Variant
Dim extList(2) As String '拡張子を2つ指定する場合
extList(0) = "xlsx"
extList(1) = "xlsm"
filePath = ""
' 指定した拡張子(配列)でない場合、再度ダイアログを表示
Do Until (filePath = False Or filePath <> "")
filePath = MAC_GetSaveAsFilename("fileName", extList)
Loop
If filePath = False Then 'ダイアログで「キャンセル」した場合、コピー保存しない
MsgBox "処理が「キャンセル」されました!" & vbCrLf & "( GetSaveAsFilename )"
Exit Sub
End If
MsgBox filePath
Exit Sub '以下、サンプル操作を実行しない(サンプル実行なら、この行を削除かコメント化)
' 以下、サンプル操作
Application.DisplayAlerts = False '確認画面を表示しないように 設定(今回は、上書き)
ActiveWorkbook.SaveCopyAs (filePath) 'ActiveWorkbook は変更されず、コピー保存される
Application.DisplayAlerts = True '確認画面を表示するように 設定を戻す
Exit Sub
myError:
Application.DisplayAlerts = True '確認画面を表示するように 設定を戻す
MsgBox "エラー発生!(sample_MAC_GetSaveAsFilename)"
End Sub
MacのVBAで利用可能な SaveFilename ダイアログは FileFilter パラメータを指定できないため、指定拡張子以外を選択した場合は再度ダイアログ表示するよう改良! こちらはVBAの Application.GetSaveAsFilename() を用いる。
sample_MAC_GetSaveAsFilename() プロシージャは、MAC_GetSaveAsFilename() 関数を呼び出すためのサンプルコード。
Function getUtiByDialog() As String
'「ファイル選択ダイアログ」でファイルの UTI を取得【UTI (Uniform Type Identifier) 調査用】
Dim scriptResult As String ' AppleScript 実行結果 (文字列)
Dim scriptParam As String ' AppleScript パラメータ(文字列)
scriptParam = "" '必要ないため、ダミーで "" をセット
scriptResult = AppleScriptTask("filePath.scpt", "getUtiByChooseFile", scriptParam)
Debug.Print scriptResult
getUtiByDialog = scriptResult
End Function
4時間ほど格闘したが「拡張子から直接UTI」変換する Cocoa AS がエラーになってしまうため、「ファイルからUTI」取得する Vanilla AS を提供。 Swift や Objective-C 実装コードの Cocoa AS 変換方法が間違っているのかもしれない。 Mac上で作成したファイルであれば確実に UTI がセットされるため、ファイル選択ダイアログで「利用したい拡張子を持つ」同ファイルを選択すること。
ファイル と UTI は 1:1 に対応するが、拡張子 と UTI は 1:n になる場合がある? macOS11 Big Sur にて「UTI」まわりが大幅に変更になり、(Core Foundationに含まれる)従来の「UTI」関連ライブラリ内の多くの機能が非推奨となりました。 AppleScript上でも use framework "UniformTypeIdentifiers" で利用可能となるUniformTypeIdentifiersフレームワーク関連が今後は拡張されるのでしょうか? 利用方法がよく分かってないだけかもしれません。 なお、Apple以外の「AppleScript Libraries」を利用する方法と 「Swift でコマンドライン・アプリを作成し、コマンド呼び出しする方法」は問題無く 拡張子からUTIを取得できました!
[command] + [Q] にてまず VBE を終了し、Excel のウィンドウ内を選択して [command] + [Q] にて Excel も終了させます。 「作業中のブック」を保存するか確認のダイアログ画面が表示された場合は 「保存」しましょう。 「自動保存」済みの場合、保存するかどうかの確認ダイアログ画面は表示されません。
AppleScriptTask コマンドの結果文字列(エラーがあれば、空文字 "" を返す)だけでなく、クリップボードにも同じ内容(改行コードは異なる)をセットしているため、必要があれば「片方のみ」に変更してください。 ただし、「フルパスやファイル名以外」を返す結果文字列の場合 クリップボードにはセットしないため、「イミディエイト ウィンドウ」にて確認してください!
AppleScript から VBA に数百ファイル以上結果が返されるのであれば、大量データが渡されるオーバーヘッドも含め、クリップボードのみの利用(結果文字列は、正常終了/異常終了のみ判れば良い)がオススメです。 また、バックグラウンド処理前提の場合は 相互で クリップボードの中身を消してしまう可能性 があるため、結果文字列のみの利用が良いでしょう。
1日2時間くらい1.5ヶ月 AppleScript を勉強した成果として、今回の記事を書きました。 Cocoa AppleScript に関しては初心者のため、不具合があればコメント等で教えて頂けると嬉しいです。
致命的な不具合が無い場合、「filePath.scpt」AppleScript は最終版になる可能性があります。 (Apple以外の「AppleScript Libraries」を利用することなく)ASOCを含む標準のAppleScriptの機能のみで 拡張子から「UTI」取得に成功した場合は、拡張子から「UTI」へ自動変換するAppleScriptコードに書き換えますが... 既に非推奨の関数のため、代替方法が今後は用意されるのかもしれません。 成功した方がいれば、その方法を ぜひ ご連絡ください!
macOS11[Big Sur]以降限定ですが、新 "UniformTypeIdentifiers" フレームワークを利用して 拡張子 or MIME から UTI取得 成功!
→ コメント(3つめ)を参照。 macOS11以降のみ利用可能なため、拡張子からの「UTI」自動変換は保留。
Cocoa関連のサンプルコードが Objective-C ではなく、 Swift が標準になってきました! Cocoa AS に書き換えるためにも、 今後は Swift も学習する必要がありそうです。 少なくとも、読める程度は...
最後まで読んでいただき、ありがとうございます。 また、お越しくださいませ。
// アタル
--「choose file」で選択したファイルの UTI を取得 with Vanilla AppleScript
--スクリプトエディタ.app」に貼り付けて、[command]+[R] で実行可能!
--以下2行は、結果サンプル
--Book2.xlsx -> "org.openxmlformats.spreadsheetml.sheet"
--Test_AppleScript_1.xlsm -> "org.openxmlformats.spreadsheetml.sheet.macroenabled"
------------------------------------------------------------
getUtiByChooseFile("")
on getUtiByChooseFile(paramStr)
try
set theAlias to (choose file) --get File's alias
tell application "System Events"
set theUTI to (theAlias's type identifier) --File's UTI (Uniform Type Identifier)
set theExt to (theAlias's name extension) -- File's 拡張子
end tell
set returnText to (" ." & theExt & " -> " & theUTI & " ") --Edit result
return returnText
on error
return "" --エラー発生時
end try
end getUtiByChooseFile
------------------------------------------------------------
--「choose file」で選択したファイルの UTI を取得 with Cocoa AppleScript (with ASOC)
--スクリプトエディタ.app」に貼り付けて、[command]+[R] で実行可能!
------------------------------------------------------------
use AppleScript version "2.5" -- El Capitan [10.11] 以降
use framework "Foundation"
use scripting additions
property |NSURL| : a reference to current application's |NSURL|
property NSURLTypeIdentifierKey : a reference to current application's NSURLTypeIdentifierKey
set aFilePath to POSIX path of (choose file) --ファイル選択ダイアログ
set utiRes to my getUTIfromPath(aFilePath)
return utiRes
on getUTIfromPath(aPOSIXPath)
set aURL to |NSURL|'s fileURLWithPath:aPOSIXPath --pathから |NSURL| objectを生成
--Cocoa AppleScriptで引数に結果を返す場合、 (reference) キーワードを用いる
set {theResult, theValue} to aURL's getResourceValue:(reference) forKey:NSURLTypeIdentifierKey |error|:(missing value) --nil(null object)をセットする場合、(missing value) を用いる
if theResult then --メソッド成功時
return (theValue as string) --UTI (Uniform Type Identifier)
else
return theResult --メソッド失敗時 false
end if
end getUTIfromPath
------------------------------------------------------------
--拡張子 or MIME から、UTI (Uniform Type Identifier) を取得【macOS11以降、限定】
--「スクリプトエディタ.app」に貼り付けて、[command]+[R] で実行可能!
--with Cocoa AppleScript (with ASOC)
------------------------------------------------------------
-- Copyright 2021- ataruchi. [ https://twitter.com/ataruchi ]
-- 拡張子 or MIME から、UTI (Uniform Type Identifier) を取得 with Cocoa AppleScript (with ASOC)
-- 新 "UniformTypeIdentifiers" framework 利用のため、macOS11[Big Sur]以降 限定
use AppleScript version "2.7" --But macOS11〜 for use new "UniformTypeIdentifiers" framework
use scripting additions
use framework "Foundation"
use framework "UniformTypeIdentifiers" --New framework for UTI, macOS11.0+ [Big Sur or later]
property UTType : a reference to current application's UTType --new Class, macOS11.0+
--property NSString : a reference to current application's NSString
set theResult to getUtiFromExt("xlsm") --マクロ付きExcel、拡張子
set theResult to theResult & return --改行コードを挿入
set theResult to (theResult & getUtiFromMime("application/pdf")) --pdf、MIME
return theResult
on getUtiFromExt(theExt) --macOS11 or later only, for use "UniformTypeIdentifiers" framework
--set theExtStr to NSString's stringWithString:theExt --create NSString's object
--set theUTType to UTType's typeWithFilenameExtension:theExtStr --create UTTyp's object
set theUTType to UTType's typeWithFilenameExtension:theExt --create UTTyp's object
if theUTType = (missing value) then return ("fail to search UTI: " & theExt)
return (theUTType's identifier as string)
end getUtiFromExt
on getUtiFromMime(theMime) --macOS11 or later only, for use "UniformTypeIdentifiers" framework
set theUTType to UTType's typeWithMIMEType:theMime --create UTTyp's object
if theUTType = (missing value) then return ("fail to search UTI: " & theMime)
return (theUTType's identifier as string)
end getUtiFromMime
------------------------------------------------------------