| |
▼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
|
|
kanabun
- 13/11/14(木) 17:48 -
