Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


21039 / 76732 ←次へ | 前へ→

【61099】Re:エクスプローラで選択されているファイル名を取得したい
回答  Abyss  - 09/4/9(木) 13:05 -

引用なし
パスワード
   IE7以降なら下記のようなコードに
なるでしょう。

(ThisWorkbook Module)
----------------------------------

'参照設定
' Microsoft Browser Helpers
' Microsoft Shell Controls And Automation

Private Declare Function BringWindowToTop Lib "User32" _
  (ByVal hWnd As Long) As Long
  
Private WithEvents ie As InternetExplorer
Private WithEvents View As ShellFolderView


Public Sub Test()
  SetExplorer "C:\"
End Sub


Public Sub SetExplorer(ByVal sPath As Variant)

  Const ShellBrowserWindow = _
      "{C08AFD90-F2A1-11D1-8455-00A0C91F3880}"
  Const CLSID_FOLDER = _
      "{EFA24E64-B078-11D0-89E4-00C04FC9E26E}"
  
  Set ie = GetObject("new:" & ShellBrowserWindow)
  With ie
    .Visible = True
    .ShowBrowserBar CLSID_FOLDER, True
    .Navigate2 sPath
  End With
  
  BringWindowToTop ie.hWnd
  
End Sub

Private Sub ie_NavigateComplete2 _
    (ByVal pDisp As Object, URL As Variant)
  Set View = pDisp.Document
  
End Sub

Private Sub view_SelectionChanged()

  Dim e As Object
  Dim i As Long
  
  Columns(1).ClearContents
  
  For Each e In View.SelectedItems
    i = i + 1
    Cells(i, 1).Value = e.Name
  Next
  
End Sub

Private Sub ie_OnQuit()
  Set View = Nothing
  Set ie = Nothing
  
End Sub

0 hits

【61060】エクスプローラで選択されているファイル名を取得したい ヨシナガ 09/4/7(火) 14:19 質問
【61067】Re:エクスプローラで選択されているファイ... Abyss 09/4/7(火) 22:41 発言
【61074】Re:エクスプローラで選択されているファイ... ichinose 09/4/8(水) 7:06 発言
【61081】Re:エクスプローラで選択されているファイ... ヨシナガ 09/4/8(水) 16:17 回答
【61083】Re:エクスプローラで選択されているファイ... Abyss 09/4/8(水) 16:30 回答
【61092】Re:エクスプローラで選択されているファイ... ヨシナガ 09/4/9(木) 9:59 お礼
【61093】Re:エクスプローラで選択されているファイ... ichinose 09/4/9(木) 10:11 発言
【61099】Re:エクスプローラで選択されているファイ... Abyss 09/4/9(木) 13:05 回答
【61139】Re:エクスプローラで選択されているファイ... ヨシナガ 09/4/10(金) 22:48 お礼
【61141】Re:エクスプローラで選択されているファイ... Abyss 09/4/10(金) 23:21 発言

21039 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free