タブーの小技 ドロップアンブロッカー

##タブーの小技　ドロップアンブロッカー

職場などで使うと便利だけども
見つかると怒られる技術

そんなこつ言ったって面倒くさいものは面倒くさい
そのパスワードに意味ある？ほんとに？
ということはたびたびありますよね

Excel VBAでフォーム作って、
そこにファイルをドロップすることで
パスワードをアンロックして開きます

①まずExcelのVBAでフォームを作成します。呼び出しボタンをシートに作ります
②そこにツールボックス上で右クリックし「その他のコントロール」-「Microsoft Web browser」にチェックを入れます
③ツールボックスの最後に追加されたWebbrowserをフォーム上に作成します
　こいつがファイルドロップを受け止める皿になります

'WorkSheet上のボタン押下時の処理
Private Sub CommandButton1_Click()
    ufDrop.Show
End Sub

ufDrop.frm

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, _
 URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
On Error GoTo Er
Dim obApp As Object
Const stPass As String = "your password"

    Debug.Print URL
    If Right(URL, 4) = "xlsx" Then  '>>>Excel
        Set obApp = CreateObject("Excel.Application")
        obApp.Workbooks.Open Filename:=URL, Password:=stPass
        obApp.Visible = True
    
    ElseIf Right(URL, 4) = "docx" Or Right(URL, 3) = "doc" Then '>>>Word
        Set obApp = CreateObject("Word.Application")
        obApp.Documents.Open Filename:=URL, PasswordDocument:=stPass
        obApp.Visible = True
                
    ElseIf Right(URL, 4) = "pptx" Then '>>>Power Point
        Set obApp = CreateObject("PowerPoint.Application")
        obApp.Presentations.Open Filename:=URL & "::" & stPass
        opapp.Visible = True
    Else
        CreateObject("Shell.Application").ShellExecute URL
    
    End If
    Cancel = True   'ドロップしたファイルの処理をブラウザにさせない
    Exit Sub
    
Er:
    Debug.Print Err.Description
    Cancel = True   'ドロップしたファイルの処理をブラウザにさせない
End Sub

以下はパスワードロックを外して開く
　拡張子 xlsx　エクセルとして開く
　拡張子 docx,doc　ワードとして開く
　拡張子 pptx　パワーポイントとして開く

以下はそのまま開く
　その他の拡張子　Windowsの定義通りに開く

※パスワード保護掛かってないファイルもドロップで開く

前回はファイル→クリップボードや
html→クリップボードで、[大量のパスワードの管理]を良くない技術で簡略化しましたが、

今回は[大量のロックされたファイル]をあれ見てこれ見てというシチュエーションです
一括ドロップには対応してないので、そこは各自