| |
ありがとうございます。
試してみます。
▼独覚 さん：
>▼はてな さん：
>標準モジュールに記載してください。
>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
|
|
さんた
- 14/11/26(水) 16:43 -
マルチーズ
- 14/11/26(水) 16:24 -
さんた
- 14/11/26(水) 16:15 -
さんた
- 14/11/26(水) 10:55 -
