| |
▼kanabun さん：
kanabun様、早速ご回答頂きまして誠にありがとうございます。
教えて頂きました内容を元に自分なりにやってみましたが、
>If dic.Exists(v(i, 1)) の部分でつまづいております。
excelのセル中にはpdfの拡張子がついていませんが、
上記の記述で存在チェックは可能なのでしょうか？
再度ご教授願えないでしょうか。
よろしくお願い致します。
>▼Kohaku さん：
>
>>例えば、 1行目の 番号 100に '.pdf' をつけて 100.pdf として
>>ネットワーク越しのフォルダ内を検索し、存在した時にそのフルパス名の
>>リンクを名前欄の右セルにセットしたい
>
>一例ですが、
>サブフォルダを含むファイルの検索は Dirコマンド というのを使うと
>比較的簡単に、けっこう速く、取得できると思います。
>今回は すべて*.pdf という拡張子なので、Dirコマンドですべての*.pdf
>ファイルを取得します。
>
>取得した{ファイル名; パス名} の組は Dictionary に登録しておくと、
>シートのファイル名が辞書のキーにあれば、対応するパス名が辞書から
>取得できます。
>
>'事前に Microsoft Scripting Runtimeへの参照設定が必要です
>Sub Try1()
> Dim dic As Dictionary
> 'Const NETPath = "\\EPSON1120\Data (D)\(Data)\*.pdf"
> Const NETPath = "\\B450\(Pub)\*.pdf" '◆適宜変更
>
> Dim tmpFile As String
> Dim strCmd As String
> Dim buf() As Byte
> Dim fList() As String, f As String, s As String
> Dim i As Long, j As Long, n As Long
>
> 'Dirコマンドの結果を出力する一時ファイル
> tmpFile = Environ$("TEMP") & "\Dir.tmp"
>
> 'Dirコマンド用の文字列を編集
> strCmd = "Dir """ & NETPath & """ /b/s > """ & tmpFile & """"
>
> 'WSHでDirコマンドを実行
> With CreateObject("Wscript.Shell")
> .Run "cmd /c" & strCmd, 7, True
> End With
>
> '該当ファイルの存在チェック
> If FileLen(tmpFile) < 1 Then
> MsgBox "該当するファイルがありません"
> Exit Sub
> End If
>
> 'Dirコマンドの結果を出力した一時ファイルを読み込み
> Open tmpFile For Binary As #1
> ReDim buf(1 To LOF(1))
> Get #1, , buf
> Close #1
> Kill tmpFile '読んだら一時アイルは削除
>
> '取得したパス名をリスト用配列に入れます
> fList() = Split(StrConv(buf, vbUnicode), vbCrLf)
> n = UBound(fList)
> '{ファイル名とパス名}を辞書に登録します
> Set dic = New Dictionary
> dic.CompareMode = TextCompare
> For i = 0 To n - 1
> s = fList(i) 'パス名
> j = InStrRev(s, "\")
> f = Mid$(s, j + 1) '正味ファイル名
> dic(f) = s
> 'Debug.Print f, s
> Next
>
> 'シートのA列のファイル名が辞書にあればそのパス名を取得します
> Dim r As Range
> Dim v As Variant
> Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))
> v = r.Value
> For i = 1 To UBound(v)
> If dic.Exists(v(i, 1)) Then
> v(i, 1) = dic(v(i, 1)) 'そのファイルのあるパス名
> Else
> v(i, 1) = ""
> End If
> Next
> 'シートのB列に検索結果を貼り付ける
> r.Offset(, 1).Value = v
>End Sub
|
|
Kohaku
- 13/11/15(金) 18:20 -
