[Office用アプリ]野良アプリのススメ

ホーム
Office アドイン, Office関連, Office 2013
[Office用アプリ]野良アプリのススメ

2013.01.28

[Office用アプリ]野良アプリのススメ

「Office 用アプリの概要」にもある通り、Office用アプリを公開・配布するには下記4つの方法が用意されています。

・Office ストア – これはマイクロソフトが Office.com 上でホストおよび統制するパブリックマーケットプレースです。Office ストアでは、世界中の開発者が各自のカスタム Office ソリューションを公開および販売でき、エンドユーザーや IT プロフェッショナルはそれらをダウンロードして個人または企業で使用できます。

・SharePoint の Office 用アプリカタログ – 作業ウィンドウアプリとコンテンツアプリの場合、IT 部門でプライベートアプリカタログを展開して、Office ストアと同様の方法によってアプリを取得できるしくみを構築できます。この新しいカタログと展開プラットフォームにより、IT 部門では効率化された方法を使用して、マネージユーザーに一元的な場所から Office および SharePoint 用アプリを配布できます。

・Exchange カタログ – メールアプリ用のプライベートカタログであり、そのカタログが存在する Exchange サーバーのユーザーが利用できます。このカタログにより、企業のメールアプリ (内部で作成されたアプリや、Office ストアで入手可能かつ企業用にライセンスされたアプリを含みます) の公開と管理が可能になります。

・ネットワーク共有フォルダーのアプリカタログ – IT 部門と開発者は、作業ウィンドウアプリやコンテンツアプリを中央のネットワーク共有フォルダーに展開することもできます。この場合、マニフェストファイルの保存と管理はそのネットワーク共有フォルダーで行われます。ユーザーは、この共有フォルダーを信頼できるカタログとして指定することでアプリを取得できます。また、IT 部門では、レジストリ設定を使用してこの共有フォルダーを信頼できるカタログとして構成することもできます。

Office 用アプリの概要より

組織内ではSharePointやExchangeも利用できますが、一般的には作成したアプリを公開するのに「Office ストア」を使うことになるだろうと思います。
ただし、Office ストアでアプリを公開するためには、

「Office 用アプリの UX 設計ガイドライン」に従って画面設計をする。
「Office ストアに提出されたアプリの検証ポリシー」に沿ってアプリを開発する。
「[方法] Microsoft Seller Dashboard の販売者アカウントを作成または編集する」にあるようにMicrosoft 販売者ダッシュボードでアカウントの承認を受ける。
「[方法] アプリを Microsoft Seller Dashboard に追加する」にあるようにMicrosoft 販売者ダッシュボードに作成したアプリを登録する。
Microsoftが行う検証・テストにパスする。

といった手順が必要になります。
(あくまでも個人的な感想になりますが)正直面倒くさいです。
ちょっとしたアプリを作って知り合いにちょっと使ってもらいたい、という場合でもいちいちOffice ストアに登録する必要があるというのはかなり煩わしいのではないでしょうか。

そこで私がお薦めしたいのが「Office用アプリ(apps for Office)の概要と開発方法」でも紹介している、共有フォルダーを利用する方法です。
この方法であればOffice ストアに登録することなくユーザーにアプリを利用してもらうことが可能です。

とはいえ、この方法だとOffice用アプリ(apps for Office)の概要と開発方法にも書いた通り、ユーザー側で共有フォルダーを用意してもらい、そのフォルダーのパスを信頼できるアプリカタログに追加してもらう必要があるため(Office用アプリ(apps for Office)の概要と開発方法 “マニフェストファイルの準備“参照)、多少の手間が掛かります。
その手間を省くために考えたのが下記スクリプトです。

■ SetAfoTrustedCatalogs.vbs

'*********************************************************************
' [Office 2013]信頼できるアプリカタログのアドレス設定スクリプト
'   - 共有フォルダーの設定 -> アプリカタログのアドレス追加
'
' Author    : kinuasa
' Date      : 2013/01/24
' Version   : 1.00
'*********************************************************************

Option Explicit

Dim ShareName   '共有フォルダーの共有名
Dim UserNm      'ユーザー名
Dim FolderPath  'マニフェストファイルを保存するフォルダーパス
Const LocalAddress = "\\127.0.0.1\"

'Officeアプリケーション(Excel,Word,PowerPoint)が起動しているか簡易的にチェック
If ChkRunningOfficeApp() Then
  MsgBox "Officeアプリケーション(Excel,Word,PowerPoint)を終了してから再度実行してください。", vbExclamation + vbSystemModal
  WScript.Quit
End If

'共有フォルダー・信頼できるカタログ設定
ShareName = InputBox("共有フォルダーの共有名を入力してください。" & vbCrLf & vbCrLf & "例:[\\192.168.1.1\MyFolder]という共有フォルダーの場合[MyFolder]の部分が共有名になります。")
If Len(Trim(ShareName)) < 1 Then WScript.Quit
If ChkStr(ShareName) Then
  MsgBox "共有名に半角英数字以外を使用しないでください。" & vbCrLf & "処理を中止します。", vbExclamation + vbSystemModal
  WScript.Quit
End If
If IsSharedFolderExists(ShareName) Then
  MsgBox "共有名[" & ShareName & "]はすでに存在しています。" & vbCrLf & "別の共有名を指定してください。", vbExclamation + vbSystemModal
  WScript.Quit
End If
If IsUrlExists(LocalAddress & ShareName) Then
  MsgBox "すでに信頼できるカタログに[" & LocalAddress & ShareName & "]が設定されています。" & vbCrLf & "処理を中止します。", vbExclamation + vbSystemModal
  WScript.Quit
End If
FolderPath = GetFolderPath("マニフェストファイルを保存するフォルダーを選択してください。" & vbCrLf & "※ 選択したフォルダーは共有フォルダーになります。")
If Len(Trim(FolderPath)) < 1 Then WScript.Quit
UserNm = CreateObject("WScript.Network").UserName
SetSharedFolder ShareName, FolderPath, UserNm '共有フォルダー設定(制限ユーザー名:現在のユーザー)
SetCatalogLocation LocalAddress & ShareName

MsgBox "処理が終了しました。", vbInformation + vbSystemModal


Private Sub SetSharedFolder(ByVal ShareName, ByVal FolderPath, ByVal UserNm)
'共有フォルダー設定(制限ユーザー数:1)
  Dim com
  
  com = "share """ & ShareName & ChrW(61) & FolderPath & """ /grant:""" & UserNm & ",full"" /users:1"
  CreateObject("Shell.Application").ShellExecute "net", com, "", "runas"
End Sub

Private Sub SetCatalogLocation(ByVal url)
'信頼できるカタログのアドレス設定
  Dim guid
  Const KeyName = "HKCU\Software\Microsoft\Office\15.0\WEF\TrustedCatalogs\"
  
  guid = GetGUID()
  'MsgBox guid '確認用
  UncheckFlags
  With CreateObject("WScript.Shell")
    .RegWrite KeyName & guid & ChrW(92) & "Flags", 1, "REG_DWORD"
    .RegWrite KeyName & guid & ChrW(92) & "Id", guid, "REG_SZ"
    .RegWrite KeyName & guid & ChrW(92) & "Url", url, "REG_SZ"
  End With
End Sub

Private Sub UncheckFlags()
'[メニューに表示する]チェックを外す
  Dim reg
  Dim keys
  Dim rn, rt
  Dim v
  Dim i, j
  Const HKEY_CURRENT_USER = &H80000001
  Const SubKeyName = "Software\Microsoft\Office\15.0\WEF\TrustedCatalogs"
  
  Set reg = CreateObject("WbemScripting.SWbemLocator").ConnectServer(, "root\default").Get("StdRegProv")
  reg.EnumKey HKEY_CURRENT_USER, SubKeyName, keys
  If Not IsNull(keys) Then
    For i = LBound(keys) To UBound(keys)
      reg.EnumValues HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn, rt
      For j = LBound(rn) To UBound(rn)
        If LCase(rn(j)) = "flags" Then
          reg.GetDWORDValue HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn(j), v
          Select Case CLng(v)
            Case 1: reg.SetDWORDValue HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn(j), 0
          End Select
          Exit For
        End If
      Next
    Next
  End If
End Sub

Private Function ChkRunningOfficeApp()
'Officeアプリケーションの起動チェック
  Dim ex, wd, pp
  Dim ret
  
  Set ex = Nothing: Set wd = Nothing: Set pp = Nothing: ret = False '初期化
  On Error Resume Next
  Set ex = GetObject(, "Excel.Application")
  Set wd = GetObject(, "Word.Application")
  Set pp = GetObject(, "PowerPoint.Application")
  On Error GoTo 0
  If Not ex Is Nothing Then ret = True
  If Not wd Is Nothing Then ret = True
  If Not pp Is Nothing Then ret = True
  ChkRunningOfficeApp = ret
End Function

Private Function ChkStr(ByVal Str)
'半角英数字チェック
  Dim ret
  
  ret = False '初期化
  With CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Global = True
    .Pattern = "[^a-zA-Z0-9]"
    If .Test(Str) Then ret = True
  End With
  ChkStr = ret
End Function

Private Function GetFolderPath(ByVal DlgTitle)
'フォルダー選択
  Dim ret
  Dim f
  Const ssfDESKTOPDIRECTORY = &H10
  
  ret = "": Set f = Nothing '初期化
  With CreateObject("Shell.Application")
    Set f = .BrowseForFolder(0, DlgTitle, &H1 + &H10, .Namespace(ssfDESKTOPDIRECTORY).Self.Path)
    If Not f Is Nothing Then
      ret = f.Self.Path
      If Right(ret, 1) = ChrW(92) Then ret = Left(ret, Len(ret) - 1)
    End If
  End With
  GetFolderPath = ret
End Function

Private Function IsSharedFolderExists(ByVal ShareName)
'共有フォルダーがすでに存在しているかチェック
  Dim ret
  
  ret = False '初期化
  If CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_Share Where Name = '" & ShareName & "'").Count > 0 Then ret = True
  IsSharedFolderExists = ret
End Function

Private Function IsUrlExists(ByVal url)
'レジストリーにすでにURLが登録されているかチェック
  Dim ret
  Dim reg
  Dim keys
  Dim rn, rt
  Dim v
  Dim i, j
  Const HKEY_CURRENT_USER = &H80000001
  Const SubKeyName = "Software\Microsoft\Office\15.0\WEF\TrustedCatalogs"
  
  ret = False '初期化
  Set reg = CreateObject("WbemScripting.SWbemLocator").ConnectServer(, "root\default").Get("StdRegProv")
  reg.EnumKey HKEY_CURRENT_USER, SubKeyName, keys
  If Not IsNull(keys) Then
    For i = LBound(keys) To UBound(keys)
      reg.EnumValues HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn, rt
      For j = LBound(rn) To UBound(rn)
        If LCase(rn(j)) = "url" Then
          reg.GetStringValue HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn(j), v
          If v = url Then
            ret = True
            Exit For
          End If
        End If
      Next
    Next
  End If
  IsUrlExists = ret
End Function

Private Function GetGUID()
'GUID生成
  GetGUID = ChrW(123) & Mid(CreateObject("Scriptlet.TypeLib").GUID, 2, 36) & ChrW(125)
End Function

使い方は下記の通りで、上記スクリプトを実行するとPC内の指定したフォルダーを共有フォルダーにして、「信頼できるアプリカタログ」に共有フォルダーのパスを追加します。

共有フォルダーの共有名を入力します(半角英数字のみ)。

Office 用アプリのマニフェストファイルを保存するフォルダーを選択します(※ このフォルダーが共有フォルダーになります)。

共有フォルダー設定時にユーザーアカウント制御の警告が表示される場合があるので、「はい」ボタンをクリックして変更を許可します。

Officeアプリケーションを起動してセキュリティセンターを開くと、「信頼できるアプリカタログ」にスクリプトから設定した共有フォルダーが追加されていることが確認できます。

このスクリプトによりユーザー環境にマニフェストファイルを保存する、カタログフォルダーが用意できるので、アプリ開発者はマニフェストファイルをそのフォルダーに保存してもらうだけでアプリを使用してもらえるようになるわけです(もちろんアプリ本体となるファイルは別途Webサーバー上に必要になるわけですが…)。

具体的な動作は実際に動かしてみるのが一番分かりやすいので、私の方でサンプル用のマニフェストファイルを用意しました。

■ sample.xml

<OfficeApp xmlns="http://schemas.microsoft.com/office/appforoffice/1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="TaskPaneApp">
  <Id>17c52bc6-b5a9-4196-a80a-0a87470a4fb5</Id>
  <Version>1.0</Version>
  <ProviderName>kinuasa</ProviderName>
  <DefaultLocale>ja-JP</DefaultLocale>
  <DisplayName DefaultValue="動作確認用Office用アプリ" />
  <Description DefaultValue="動作確認用のOffice 用アプリです。"/>
  <Capabilities>
    <Capability Name="Document" />
    <Capability Name="Workbook" />
    <Capability Name="Presentation" />
  </Capabilities>
  <DefaultSettings>
    <SourceLocation DefaultValue="http://afo.devel.jp/apps/sample.html" />
  </DefaultSettings>
  <Permissions>ReadWriteDocument</Permissions>
</OfficeApp>

上記マニフェストファイルを”SetAfoTrustedCatalogs.vbs“で用意したカタログフォルダーに保存した後、Officeアプリケーション(Excel,Word,PowerPoint)を実行すると、挿入タブの「Office 用アプリ」から「動作確認用Office用アプリ」が挿入できるようになります。

以上のように、ここではOffice 用アプリの所謂”野良アプリ“を使用する方法について説明してきましたが、野良アプリはあくまでも野良、公式に認可・署名されたものではありませんので、その利用は自己責任で行う必要があります。

開発者側も、アプリを配布する際にはなるべくなら公式に用意された方法を用いた方が良いでしょう。
販売者登録やアプリの審査といった面倒な手間は掛かりますが、”Microsoftがテストして署名したアプリ“というお墨付きが得られるメリットは大きいものです。

私が今回紹介した方法は、アプリを配布するのにこういった方法もあるんじゃないかという、ニッチで隙間的な手法に過ぎませんが、どなたかのお役に立てれば幸いです。

ちなみに、信頼できるアプリカタログに追加する”SetAfoTrustedCatalogs.vbs“ファイルとは逆にアプリカタログの登録とフォルダーの共有設定を解除する「DelAfoTrustedCatalogs.vbs」ファイルも下記リンクに用意しましたので合わせてご利用ください。

■ DelAfoTrustedCatalogs.vbs

'*********************************************************************
' [Office 2013]信頼できるアプリカタログのアドレス削除スクリプト
'   - 共有フォルダーの指定 -> アプリカタログからアドレス削除,
'                             フォルダーの共有設定解除
'
' Author    : kinuasa
' Date      : 2013/01/24
' Version   : 1.00
'*********************************************************************

Option Explicit

Dim FolderPath  'マニフェストファイルを保存するフォルダーパス
Dim tmp
Dim itms, itm
Const LocalAddress = "\\127.0.0.1\"

'Officeアプリケーション(Excel,Word,PowerPoint)が起動しているか簡易的にチェック
If ChkRunningOfficeApp() Then
  MsgBox "Officeアプリケーション(Excel,Word,PowerPoint)を終了してから再度実行してください。", vbExclamation + vbSystemModal
  WScript.Quit
End If

'信頼できるカタログの登録とフォルダーの共有設定を解除
FolderPath = GetFolderPath("マニフェストファイル保存用のフォルダーを選択してください。" & vbCrLf & "※ 選択したフォルダーが信頼できるカタログに登録されている場合はその登録とフォルダーの共有設定が解除されます。")
If Len(Trim(FolderPath)) < 1 Then WScript.Quit
tmp = Replace(FolderPath, ChrW(92), ChrW(92) & ChrW(92))
Set itms = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_Share Where Path = '" & tmp & "'")
If itms.Count > 0 Then
  For Each itm In itms
    DelCatalogUrl LocalAddress & itm.Name
    DelSharedFolder itm.Name
  Next
  MsgBox "信頼できるカタログの登録とフォルダーの共有設定を解除しました。", vbInformation + vbSystemModal
Else
  MsgBox "信頼できるカタログに登録されている共有フォルダーではありません。" & vbCrLf & "処理を中止します。", vbExclamation + vbSystemModal
End If


Private Sub DelCatalogUrl(ByVal url)
'信頼できるカタログにURLが登録されていればレジストリキーを削除
  Dim ret
  Dim reg
  Dim keys
  Dim rn, rt
  Dim v
  Dim i, j
  Const HKEY_CURRENT_USER = &H80000001
  Const SubKeyName = "Software\Microsoft\Office\15.0\WEF\TrustedCatalogs"
  
  ret = False '初期化
  Set reg = CreateObject("WbemScripting.SWbemLocator").ConnectServer(, "root\default").Get("StdRegProv")
  reg.EnumKey HKEY_CURRENT_USER, SubKeyName, keys
  If Not IsNull(keys) Then
    For i = LBound(keys) To UBound(keys)
      reg.EnumValues HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn, rt
      For j = LBound(rn) To UBound(rn)
        If LCase(rn(j)) = "url" Then
          reg.GetStringValue HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i), rn(j), v
          If v = url Then
            reg.DeleteKey HKEY_CURRENT_USER, SubKeyName & ChrW(92) & keys(i)
            Exit Sub
          End If
        End If
      Next
    Next
  End If
End Sub

Private Sub DelSharedFolder(ByVal ShareName)
'フォルダーの共有設定解除
  Dim com
  
  com = "share """ & ShareName & """ /delete"
  CreateObject("Shell.Application").ShellExecute "net", com, "", "runas"
End Sub

Private Function ChkRunningOfficeApp()
'Officeアプリケーションの起動チェック
  Dim ex, wd, pp
  Dim ret
  
  Set ex = Nothing: Set wd = Nothing: Set pp = Nothing: ret = False '初期化
  On Error Resume Next
  Set ex = GetObject(, "Excel.Application")
  Set wd = GetObject(, "Word.Application")
  Set pp = GetObject(, "PowerPoint.Application")
  On Error GoTo 0
  If Not ex Is Nothing Then ret = True
  If Not wd Is Nothing Then ret = True
  If Not pp Is Nothing Then ret = True
  ChkRunningOfficeApp = ret
End Function

Private Function GetFolderPath(ByVal DlgTitle)
'フォルダー選択
  Dim ret
  Dim f
  Const ssfDESKTOPDIRECTORY = &H10
  
  ret = "": Set f = Nothing '初期化
  With CreateObject("Shell.Application")
    Set f = .BrowseForFolder(0, DlgTitle, &H1 + &H10, .Namespace(ssfDESKTOPDIRECTORY).Self.Path)
    If Not f Is Nothing Then
      ret = f.Self.Path
      If Right(ret, 1) = ChrW(92) Then ret = Left(ret, Len(ret) - 1)
    End If
  End With
  GetFolderPath = ret
End Function