Excel VBA質問箱 IV

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

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


1071 / 13644 ツリー ←次へ | 前へ→

【76393】フォルダが開かれているかどうか はてな 14/11/18(火) 12:08 質問[未読]
【76394】Re:フォルダが開かれているかどうか 独覚 14/11/18(火) 14:37 回答[未読]
【76395】Re:フォルダが開かれているかどうか はてな 14/11/18(火) 15:03 お礼[未読]
【76460】Re:フォルダが開かれているかどうか はてな 14/12/5(金) 20:57 お礼[未読]
【76461】Re:フォルダが開かれているかどうか γ 14/12/6(土) 7:58 発言[未読]
【76469】Re:フォルダが開かれているかどうか はてな 14/12/7(日) 22:54 お礼[未読]

【76393】フォルダが開かれているかどうか
質問  はてな  - 14/11/18(火) 12:08 -

引用なし
パスワード
   フォルダを開くのはネットで見つけました。

Shell "C:\Windows\Explorer.exe " & fdname, vbNormalFocus

開いていたら開く必要がないのですが、
フォルダが開かれているかどうか確認するにはどうしたらいいですか?

【76394】Re:フォルダが開かれているかどうか
回答  独覚  - 14/11/18(火) 14:37 -

引用なし
パスワード
   ▼はてな さん:
標準モジュールに記載してください。
Sheet1のA1セルに記入されているパスがファイルエクスプローラーで開かれているかをチェックします。

「Sub DirChk()」の
>  If CHK_FLG Then
>    MsgBox "開いてない"
>  Else
>    MsgBox "開いてる"
>  End If
に実際に行いたい処理を入れてください。
また、今は大文字・小文字の区別をしないようにしています。
区別させたい場合は
>'      If CHK_DIR = CHK_Collection(Loop_CNT) Then  '大文字(A)と小文字(a)を区別する
>      If StrConv(CHK_DIR, vbUpperCase) = StrConv(CHK_Collection(Loop_CNT), vbUpperCase) Then
部分のコメントを逆にしてください。
なお、「Function getOpenDirList() As Collection」のほうは

ht tp://grayskybluesea.wordpress.com/2010/05/14/vba%E3%81%A7%E3%80%81%E9%
96%8B%E3%81%84%E3%81%A6%E3%81%84%E3%82%8B%E3%83%95%E3%82%A9%E3%83%AB%E3%83%
80%E3%83%91%E3%82%B9%E3%82%92%E5%85%A8%E3%81%A6%E5%8F%96%E5%BE%97%E3%81%99%
E3%82%8Bfunction/


を元にしています。
(ほとんどそのままですが)

Sub DirChk()

  Dim CHK_DIR     As String
  Dim CHK_FLG     As String
  Dim CHK_Collection As Collection
  Dim CHK_DIR_CNT   As Integer
  Dim Loop_CNT    As Integer

  CHK_DIR = Worksheets("Sheet1").Range("A1")

'  パスの最後に"\"があれば削除する
  If Right(CHK_DIR, 1) = "\" Then
    CHK_DIR = Left(CHK_DIR, Len(CHK_DIR) - 1)
  End If
  
  Set CHK_Collection = getOpenDirList()
  CHK_FLG = True
  
  CHK_DIR_CNT = CHK_Collection.Count
  
  If CHK_DIR_CNT > 0 Then
    For Loop_CNT = 1 To CHK_DIR_CNT
'      If CHK_DIR = CHK_Collection(Loop_CNT) Then  '大文字(A)と小文字(a)を区別する

      If StrConv(CHK_DIR, vbUpperCase) = StrConv(CHK_Collection(Loop_CNT), vbUpperCase) Then
        CHK_FLG = False
        Exit For
      End If
    Next
  End If
  
  If CHK_FLG Then
    MsgBox "開いてない"
  Else
    MsgBox "開いてる"
  End If
  
End Sub


Function getOpenDirList() As Collection
  Dim s    As String
  Dim res   As New Collection
  Dim sh   As Object
  Dim wcobj  As Object
  Dim wobj  As Object
  Dim result As String
  Dim i    As Integer

'オブジェクトの取得
  Set sh = CreateObject("Shell.Application")

'コレクションオブジェクトの取得
  Set wcobj = sh.Windows

  For Each wobj In wcobj
'Internt Explorerが開いているファイルは除外する。
    If (wobj.FullName Like "*Explorer.EXE") = True Then
      s = wobj.LocationURL
'オブジェクトフォルダは除外する
      If Left(s, 10) <> "file:///::" Then
' 最初の"file:///"を取り除く
        If s Like "file:///?:*" Then

'ローカル
          s = Right(s, Len(s) - Len("file:///"))
        Else

'サーバ
          s = Right(s, Len(s) - Len("file:"))
        End If

' 左から1文字ずつチェックして文字列を置き換えていく
        result = ""
        For i = 1 To Len(s)
          Select Case Mid(s, i, 1)
            Case "/"
              result = result & "\"
            Case "%"
              result = result & Chr(CInt("&H" & Mid(s, i + 1, 2)))
              i = i + 2
            Case Else
              result = result & Mid(s, i, 1)
          End Select
        Next
        res.Add (result)

      End If
    End If
  Next
  Set getOpenDirList = res
End Function

【76395】Re:フォルダが開かれているかどうか
お礼  はてな  - 14/11/18(火) 15:03 -

引用なし
パスワード
   ありがとうございます。

試してみます。

▼独覚 さん:
>▼はてな さん:
>標準モジュールに記載してください。
>Sheet1のA1セルに記入されているパスがファイルエクスプローラーで開かれているかをチェックします。
>
>「Sub DirChk()」の
>>  If CHK_FLG Then
>>    MsgBox "開いてない"
>>  Else
>>    MsgBox "開いてる"
>>  End If
>に実際に行いたい処理を入れてください。
>また、今は大文字・小文字の区別をしないようにしています。
>区別させたい場合は
>>'      If CHK_DIR = CHK_Collection(Loop_CNT) Then  '大文字(A)と小文字(a)を区別する
>>      If StrConv(CHK_DIR, vbUpperCase) = StrConv(CHK_Collection(Loop_CNT), vbUpperCase) Then
>部分のコメントを逆にしてください。
>なお、「Function getOpenDirList() As Collection」のほうは
>
>ht tp://grayskybluesea.wordpress.com/2010/05/14/vba%E3%81%A7%E3%80%81%E9%
>96%8B%E3%81%84%E3%81%A6%E3%81%84%E3%82%8B%E3%83%95%E3%82%A9%E3%83%AB%E3%83%
>80%E3%83%91%E3%82%B9%E3%82%92%E5%85%A8%E3%81%A6%E5%8F%96%E5%BE%97%E3%81%99%
>E3%82%8Bfunction/
>
>
>を元にしています。
>(ほとんどそのままですが)
>
>Sub DirChk()
>
>  Dim CHK_DIR     As String
>  Dim CHK_FLG     As String
>  Dim CHK_Collection As Collection
>  Dim CHK_DIR_CNT   As Integer
>  Dim Loop_CNT    As Integer
>
>  CHK_DIR = Worksheets("Sheet1").Range("A1")
>
>'  パスの最後に"\"があれば削除する
>  If Right(CHK_DIR, 1) = "\" Then
>    CHK_DIR = Left(CHK_DIR, Len(CHK_DIR) - 1)
>  End If
>  
>  Set CHK_Collection = getOpenDirList()
>  CHK_FLG = True
>  
>  CHK_DIR_CNT = CHK_Collection.Count
>  
>  If CHK_DIR_CNT > 0 Then
>    For Loop_CNT = 1 To CHK_DIR_CNT
>'      If CHK_DIR = CHK_Collection(Loop_CNT) Then  '大文字(A)と小文字(a)を区別する
>
>      If StrConv(CHK_DIR, vbUpperCase) = StrConv(CHK_Collection(Loop_CNT), vbUpperCase) Then
>        CHK_FLG = False
>        Exit For
>      End If
>    Next
>  End If
>  
>  If CHK_FLG Then
>    MsgBox "開いてない"
>  Else
>    MsgBox "開いてる"
>  End If
>  
>End Sub
>
>
>Function getOpenDirList() As Collection
>  Dim s    As String
>  Dim res   As New Collection
>  Dim sh   As Object
>  Dim wcobj  As Object
>  Dim wobj  As Object
>  Dim result As String
>  Dim i    As Integer
>
>'オブジェクトの取得
>  Set sh = CreateObject("Shell.Application")
>
>'コレクションオブジェクトの取得
>  Set wcobj = sh.Windows
>
>  For Each wobj In wcobj
>'Internt Explorerが開いているファイルは除外する。
>    If (wobj.FullName Like "*Explorer.EXE") = True Then
>      s = wobj.LocationURL
>'オブジェクトフォルダは除外する
>      If Left(s, 10) <> "file:///::" Then
>' 最初の"file:///"を取り除く
>        If s Like "file:///?:*" Then
>
>'ローカル
>          s = Right(s, Len(s) - Len("file:///"))
>        Else
>
>'サーバ
>          s = Right(s, Len(s) - Len("file:"))
>        End If
>
>' 左から1文字ずつチェックして文字列を置き換えていく
>        result = ""
>        For i = 1 To Len(s)
>          Select Case Mid(s, i, 1)
>            Case "/"
>              result = result & "\"
>            Case "%"
>              result = result & Chr(CInt("&H" & Mid(s, i + 1, 2)))
>              i = i + 2
>            Case Else
>              result = result & Mid(s, i, 1)
>          End Select
>        Next
>        res.Add (result)
>
>      End If
>    End If
>  Next
>  Set getOpenDirList = res
>End Function

【76460】Re:フォルダが開かれているかどうか
お礼  はてな  - 14/12/5(金) 20:57 -

引用なし
パスワード
   うまくいきました。
ありがとうございます。

ただ

 ここがいまちちわかりません。
     "file:///?:*" 特に?:* ここ

     →  If s Like "file:///?:*" Then ' 最初の"file:///"を取り除く
          s = Right(s, Len(s) - Len("file:///")) 'ローカル
        Else
          s = Right(s, Len(s) - Len("file:")) 'サーバ
        End If

 自分なりに調べてみます。

【76461】Re:フォルダが開かれているかどうか
発言  γ  - 14/12/6(土) 7:58 -

引用なし
パスワード
   解決されたようで何よりです。
Like演算子のヘルプにあるように、
? は 任意の 1 文字
* は 任意の数の文字
を表します。

【76469】Re:フォルダが開かれているかどうか
お礼  はてな  - 14/12/7(日) 22:54 -

引用なし
パスワード
   なるほど。
わざわざありがとうございます。

▼γ さん:
>解決されたようで何よりです。
>Like演算子のヘルプにあるように、
>? は 任意の 1 文字
>* は 任意の数の文字
>を表します。

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