Excel VBA質問箱 IV

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

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


51200 / 76738 ←次へ | 前へ→

【30411】Re:セルの文字にワイルドカードを利用し、ファイル一覧を表示、外部ソフトで開くには
発言  ichinose  - 05/10/26(水) 23:04 -

引用なし
パスワード
   ▼いどっと さん:
こんばんは。

>下記の操作を自動化するためにどのようなマクロを組めばよいかご教示願います。
>
>仕様条件:
>ある部品の番号(123456)がエクセルのリストにある。
>その部品の図面がPDFファイルで、とあるフォルダ(zumen)にある。
>図面のPDFファイルは、用紙枚数により_01(123456_01.pdf)が付加されている。
>ファイル一覧のダイアログボックスを起動し、(123456*.pdf)を検索条件に付与し、PDFファイルを開く。
>
>特定のファイルを開くのは、ハイパーリンクで可能ですが、上記にあるように図面の枚数によりファイル名が変わってしまうという情けないシステムのため、図面検索の容易化を進めています。簡単なマクロしか作ったことありませんので、うまくいきません。お助けください。
>
>よろしくお願いいたします。
一例ですが、こんなコードで特定のフォルダ内のファイルを検索することはできます。

標準モジュールに
'===========================================================
Sub find_file_sammple()
  Dim fso As Object
  Dim fld As Object
  Dim fl As Object
  Dim fldnm As Variant
  fldnm = get_folder_path("フォルダを選択してください")
  If TypeName(fldnm) <> "Boolean" Then
    findwd = Application.InputBox("検索条件を入力してください 例(k*.xls)")
    If TypeName(findwd) <> "Boolean" Then
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fld = fso.GetFolder(fldnm)
     For Each fl In fld.Files
       If LCase(fl.Name) Like findwd Then
        MsgBox fl.Name
        End If
       Next
     End If
    End If
End Sub
'=========================================================================
Function get_folder_path(mes)
  Dim fld As Object
  Set fld = CreateObject("Shell.Application").BrowseForFolder(0, mes, 1, 17)
  On Error Resume Next
  If Not fld Is Nothing Then
    get_folder_path = fld.items.Item.Path
    If Err.Number <> 0 Then
     get_folder_path = False
     End If
  Else
    get_folder_path = False
    End If
  Set fld = Nothing
End Function

これは、条件に合ったファイル名をMsgbox関数で表示していますが、
取得したファイル名をどこに出力するか仕様次第です。
セルに順序良く表示するか、ユーザーフォームを使うか・・・、etc。

まずは、確認してください。
0 hits

【30372】セルの文字にワイルドカードを利用し、ファイル一覧を表示、外部ソフトで開... いどっと 05/10/26(水) 9:28 質問
【30411】Re:セルの文字にワイルドカードを利用し、... ichinose 05/10/26(水) 23:04 発言
【30412】Re:セルの文字にワイルドカードを利用し、... いどっと 05/10/26(水) 23:35 お礼
【30415】Re:セルの文字にワイルドカードを利用し、... ichinose 05/10/27(木) 7:36 発言
【30416】Re:セルの文字にワイルドカードを利用し、... いどっと 05/10/27(木) 8:20 お礼

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