Office関連

input type fileの「アップロードするファイルの選択」ダイアログを制御するVBAマクロ

久しぶりのVBAネタです。
「Internet Explorerを操作して input type="file" で表示される“アップロードするファイルの選択ダイアログ”を制御できないか?」とのご質問をいただきました。

Q&Aサイトでもたまに見かける質問です。
それだけ多くの方が躓かれているのだろうと思います。

最初に断っておきますと、個人的には input type="file" の制御は考えない方が良いと思っています。

セキュリティ上の観点からIE8の時点ですでに読み取り専用になっていますし(下記参照)、ここを無理して自動化するよりは、サイト側で用意されているAPI等、正規の方法を検討した方が良いだろうと思います。

ユーザーが入力するローカル ファイルのパスをキーストロークの監視によって “盗む” 攻撃を防ぐため、ファイル パスの編集ボックスを読み取り専用にしました。ファイルをアップロードする場合、ユーザーはファイルの参照ダイアログ ボックスを使用してファイルを指定する必要があります。

https://docs.microsoft.com/ja-jp/previous-versions/msdn10/dd550608(v=msdn.10) より

とはいえ、 input type="file" で表示される「アップロードするファイルの選択」ダイアログの制御には興味があったので、今回試してみることにしました。

input type="file" の「アップロードするファイルの選択」ダイアログを制御するVBAマクロ

※下記コードの実行は自己責任で行ってください。
※下記コードはダイアログの仕様変更によって、実行できなくなる可能性があります。

Option Explicit

Public Sub Sample()
  Dim tmpFolderPath As String
  Dim scriptPath As String
  Dim batchPath As String
  Dim dt As String
  Const TemporaryFolder = 2
  Const READYSTATE_COMPLETE = 4
  Const UploadFilePath = "C:\wk\tmp\漢 字 ファイルテ_ス_ト.txt" 'アップロードするファイルのパス
  
  'スクリプト・バッチのパス設定
  dt = Format(Now, "yyyymmddhhnnss")
  With CreateObject("Scripting.FileSystemObject")
    tmpFolderPath = .GetSpecialFolder(TemporaryFolder).Path
    scriptPath = .BuildPath(tmpFolderPath, dt & "_SendFilePathToUploadDialog.ps1")
    batchPath = .BuildPath(tmpFolderPath, dt & "_SendFilePathToUploadDialog.bat")
  End With
  
  'IE操作
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .Navigate "https://localhost/sample/file.html"
    Do While (.Busy = True) Or (.ReadyState <> READYSTATE_COMPLETE)
      DoEvents
    Loop
    
    '[アップロードするファイルの選択]ダイアログ表示前にパス設定処理実行
    SendFilePathToUploadDialog UploadFilePath, scriptPath, batchPath
    .document.getElementsByTagName("input")(0).Click
    
    .document.getElementsByTagName("input")(1).Click
  End With
  
  Kill scriptPath: Kill batchPath 'スクリプト・バッチ削除
End Sub

Private Sub SendFilePathToUploadDialog(ByVal TargetFilePath As String, _
                                       ByVal ScriptFilePath As String, _
                                       ByVal BatchFilePath As String)
'[アップロードするファイルの選択]ダイアログにファイルパス設定
  Dim scriptCode As String
  Dim batchCode As String
  
  scriptCode = GetPSCode(TargetFilePath)
  batchCode = "@echo off" & vbCrLf
  batchCode = batchCode & "cd /d %~dp0" & vbCrLf
  batchCode = batchCode & "PowerShell -NoProfile -ExecutionPolicy Unrestricted """ & ScriptFilePath & """"
  
  'スクリプト・バッチ作成
  CreateScriptFile scriptCode, ScriptFilePath
  CreateScriptFile batchCode, BatchFilePath, "Shift-JIS"
  
  'バッチ経由でスクリプト実行
  CreateObject("WScript.Shell").Run BatchFilePath, 2, False
End Sub

Private Sub CreateScriptFile(ByVal Code As String, _
                             ByVal TargetFilePath As String, _
                             Optional ByVal FileCharset As String = "UTF-8")
'スクリプト・バッチファイル作成
  Const adTypeText = 2
  Const adCRLF = -1
  Const adWriteChar = 0
  Const adSaveCreateOverWrite = 2
  
  With CreateObject("ADODB.Stream")
    .Type = adTypeText
    .Charset = FileCharset
    .LineSeparator = adCRLF
    .Open
    .WriteText Code, adWriteChar
    .SaveToFile TargetFilePath, adSaveCreateOverWrite
    .Close
  End With
End Sub

Private Function GetPSCode(ByVal TargetFilePath As String) As String
'PowerShellコード取得
  Dim s As String
  
  s = "$source = @""" & vbCrLf
  s = s & "using System;" & vbCrLf
  s = s & "using System.Windows.Automation;" & vbCrLf
  s = s & "" & vbCrLf
  s = s & "namespace UIAutTools" & vbCrLf
  s = s & "{" & vbCrLf
  s = s & "  public class Program" & vbCrLf
  s = s & "  {" & vbCrLf
  s = s & "    public static void SendFilePathToUploadDialog(string filePath)" & vbCrLf
  s = s & "    {" & vbCrLf
  s = s & "      System.Threading.Thread.Sleep(2000); //ダイアログ表示待ち" & vbCrLf
  s = s & "      PropertyCondition cndDialogName = new PropertyCondition(AutomationElement.NameProperty, ""アップロードするファイルの選択"");" & vbCrLf
  s = s & "      PropertyCondition cndDialogClassName = new PropertyCondition(AutomationElement.ClassNameProperty, ""#32770"");" & vbCrLf
  s = s & "      AndCondition cndDialog = new AndCondition(new Condition[] {cndDialogName, cndDialogClassName});" & vbCrLf
  s = s & "      AutomationElement elmDialog = AutomationElement.RootElement.FindFirst(TreeScope.Subtree, cndDialog);" & vbCrLf
  s = s & "      " & vbCrLf
  s = s & "      PropertyCondition cndFileNameEditCtrlName = new PropertyCondition(AutomationElement.NameProperty, ""ファイル名(N):"");" & vbCrLf
  s = s & "      PropertyCondition cndFileNameEditCtrlClassName = new PropertyCondition(AutomationElement.ClassNameProperty, ""Edit"");" & vbCrLf
  s = s & "      AndCondition cndFileNameEditCtrl = new AndCondition(new Condition[] {cndFileNameEditCtrlName, cndFileNameEditCtrlClassName});" & vbCrLf
  s = s & "      AutomationElement elmFileNameEditCtrl = elmDialog.FindFirst(TreeScope.Subtree, cndFileNameEditCtrl);" & vbCrLf
  s = s & "      if (elmFileNameEditCtrl != null)" & vbCrLf
  s = s & "      {" & vbCrLf
  s = s & "        ValuePattern vptn = elmFileNameEditCtrl.GetCurrentPattern(ValuePattern.Pattern) as ValuePattern;" & vbCrLf
  s = s & "        vptn.SetValue(@filePath);" & vbCrLf
  s = s & "      }" & vbCrLf
  s = s & "      " & vbCrLf
  s = s & "      PropertyCondition cndOpenButtonName = new PropertyCondition(AutomationElement.NameProperty, ""開く(O)"");" & vbCrLf
  s = s & "      PropertyCondition cndOpenButtonClassName = new PropertyCondition(AutomationElement.ClassNameProperty, ""Button"");" & vbCrLf
  s = s & "      AndCondition cndOpenButton = new AndCondition(new Condition[] {cndOpenButtonName, cndOpenButtonClassName});" & vbCrLf
  s = s & "      AutomationElement elmOpenButton = elmDialog.FindFirst(TreeScope.Subtree, cndOpenButton);" & vbCrLf
  s = s & "      if (elmOpenButton != null)" & vbCrLf
  s = s & "      {" & vbCrLf
  s = s & "        InvokePattern iptn = elmOpenButton.GetCurrentPattern(InvokePattern.Pattern) as InvokePattern;" & vbCrLf
  s = s & "        iptn.Invoke();" & vbCrLf
  s = s & "      }" & vbCrLf
  s = s & "    }" & vbCrLf
  s = s & "  }" & vbCrLf
  s = s & "}" & vbCrLf
  s = s & """@" & vbCrLf
  s = s & "Add-Type -TypeDefinition $source -ReferencedAssemblies(""UIAutomationClient"", ""UIAutomationTypes"")" & vbCrLf
  s = s & "[UIAutTools.Program]::SendFilePathToUploadDialog(""" & TargetFilePath & """)"
  
  GetPSCode = s
End Function

動作画面

処理概要

上記マクロで行っている処理は下記の通りです。

  1. ダイアログを制御するためのPowerShellスクリプトを作成
  2. PowerShellスクリプトを実行するためのバッチ作成
  3. Internet Explorerを操作して「アップロードするファイルの選択」ダイアログ表示
  4. PowerShellスクリプトでダイアログ制御

ダイアログを制御するためのPowerShellスクリプト

ダイアログを制御するためのPowerShellスクリプトは下記のようなコードになっています。

$source = @"
using System;
using System.Windows.Automation;

namespace UIAutTools
{
  public class Program
  {
    public static void SendFilePathToUploadDialog(string filePath)
    {
      System.Threading.Thread.Sleep(2000); //ダイアログ表示待ち
      PropertyCondition cndDialogName = new PropertyCondition(AutomationElement.NameProperty, "アップロードするファイルの選択");
      PropertyCondition cndDialogClassName = new PropertyCondition(AutomationElement.ClassNameProperty, "#32770");
      AndCondition cndDialog = new AndCondition(new Condition[] {cndDialogName, cndDialogClassName});
      AutomationElement elmDialog = AutomationElement.RootElement.FindFirst(TreeScope.Subtree, cndDialog);
      
      PropertyCondition cndFileNameEditCtrlName = new PropertyCondition(AutomationElement.NameProperty, "ファイル名(N):");
      PropertyCondition cndFileNameEditCtrlClassName = new PropertyCondition(AutomationElement.ClassNameProperty, "Edit");
      AndCondition cndFileNameEditCtrl = new AndCondition(new Condition[] {cndFileNameEditCtrlName, cndFileNameEditCtrlClassName});
      AutomationElement elmFileNameEditCtrl = elmDialog.FindFirst(TreeScope.Subtree, cndFileNameEditCtrl);
      if (elmFileNameEditCtrl != null)
      {
        ValuePattern vptn = elmFileNameEditCtrl.GetCurrentPattern(ValuePattern.Pattern) as ValuePattern;
        vptn.SetValue(@filePath);
      }
      
      PropertyCondition cndOpenButtonName = new PropertyCondition(AutomationElement.NameProperty, "開く(O)");
      PropertyCondition cndOpenButtonClassName = new PropertyCondition(AutomationElement.ClassNameProperty, "Button");
      AndCondition cndOpenButton = new AndCondition(new Condition[] {cndOpenButtonName, cndOpenButtonClassName});
      AutomationElement elmOpenButton = elmDialog.FindFirst(TreeScope.Subtree, cndOpenButton);
      if (elmOpenButton != null)
      {
        InvokePattern iptn = elmOpenButton.GetCurrentPattern(InvokePattern.Pattern) as InvokePattern;
        iptn.Invoke();
      }
    }
  }
}
"@
Add-Type -TypeDefinition $source -ReferencedAssemblies("UIAutomationClient", "UIAutomationTypes")
[UIAutTools.Program]::SendFilePathToUploadDialog("** ファイルパス **")

普通のダイアログ制御ならUI Automationの処理だけで完結できるはずですが、PowerShellとの組み合わせによる仕様のせいか、下記サイト記載の罠にガッツリとハマりました。

私の環境では、ダイアログからAutomationElementを取得する部分のみをC#に投げた場合でも必要な要素が取得できなかったため、ダイアログの制御部分すべてをC#で書くことにしました。

セキュリティにより実行できないPowerShellの処理

最初は上記PowerShellスクリプトをエンコードして、EncodedCommandオプションで渡そうと考えていたのですが、いざ実行してみると、下図のように“セキュリティに影響を及ぼす可能性のある問題点が検知されました”警告が表示され、実行がブロックされました。

やろうとしていることはEmotetみたいなものなので、ブロックされるのも当然と言えるかもしれません。

致し方ないので、PowerShellファイル(ps1)を一時的に作成し、それをバッチファイルから実行する形をとることにしました。

おわりに

上記の通り、半ば無理やり「アップロードするファイルの選択」ダイアログを制御することはできましたが、上で書いたマクロもいつ使えなくなるか分かりませんし、やはり input type="file" の自動化は考えない方が良いだろうと思います。

場合によっては、下記サイトのようにアップロード処理を自前で実装することもできますので、 input type="file" の制御を行う前に、まずは他にできることを検討してはいかがでしょうか。

関連記事

【感想】企画展「国立公園」に行ってきたよ前のページ

[Office Scripts]ウィンドウ枠の固定と解除を行う方法次のページ

関連記事

  1. Office関連

    Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)

    下記記事にあるように、ニューラルネット機械翻訳の導入によって、Goog…

  2. Office関連

    [Excel Services ECMAScript]アクティブセルが変更されたときのイベントを利用…

    埋め込んだExcelワークブックの、アクティブセルが変更されたときのイ…

  3. Office関連

    日経ソフトウエア 2014年 10月号 「VBAでExcelを業務アプリ化」

    購読している雑誌、日経ソフトウエア 2014年 10月号に「イベントプ…

  4. Office関連

    Excel 2013で駅すぱあとWebサービス APIの「経路探索」を使ってみました。

    「「駅すぱあとWebサービス API無償提供」を利用してみました。」で…

  5. Office関連

    ルビ(ふりがな)を一括設定するWordマクロ

    2016/10/28 追記:改良版のマクロを書きました。…

  6. Office関連

    Office 365 APIをVBAから呼び出す(1)

    2015年4月に公開されたOffice Teamのブログ記事「Toda…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP