こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

excel vbaでハイパーリンクを設定するには

お世話様です。
Excecl2000での質問です。
C:の中に「SAISYO」というフォルダがあります。
この「SAISYO」の中には「TUGI」というフォルダや「ファイル1」というファイルがあります。
そして「TUGI」の中には「SONOTUGI」というフォルダや「ファイル2」というファイルがあります。
やりたいことは、Sheet1にあるボタンをクリックすると「SAISYO」の中のすべてのファイルのパスをハイパーリンク形式でA1.A2.A3・・・のセルに書き出したいんです。
最終的には書き加えたいことがあるので、ソフトの使用ではなくコードが知りたいのです。

色々試したのですがフォルダの中のフォルダの中のファイルのパスの取得とハイパーリンク形式で、というところがどうしてもわかりません。お詳しい方是非教えてください。

よろしくお願いします。

投稿日時 - 2007-03-23 15:50:46

QNo.2858520

困ってます

質問者が選んだベストアンサー

ハイパーリンクの設定はマクロの記録で出来るかと思いますけど・・・

こんな感じで如何でしょ
ListUp を実行して下さい

Function GetSubDir(strTrgDir As String, Optional rRow As Integer) As Boolean
  Dim objFs As Object
  Dim objDir As Object
  Dim objFile As Object
  
  On Error GoTo errHnd
  Set objFs = CreateObject("Scripting.FileSystemObject")
  Set objDir = objFs.Getfolder(strTrgDir)
  Set objFile = objDir.Files

  For Each objFile In objDir.Files
    rRow = rRow + 1
    'Debug.Print "rRow = " & rRow, "file = " & objFile.Path
    Worksheets("sheet1").Hyperlinks.Add _
    Anchor:=Cells(rRow, 1), _
    Address:=objFile.Path, _
    TextToDisplay:=objFile.Path
  Next
  
  For Each objDir In objDir.subfolders
    Call GetSubDir(objDir.Path, rRow) '←サブフォルダを見に行きます
  Next
  
  Set objFs = Nothing
  Set objDir = Nothing
  GetSubDir = True
  Exit Function
errHnd:
  Debug.Print Err.Number, Err.Description
End Function

Sub ListUp()
  MsgBox IIf(GetSubDir("c:\saisyo") = True, "成功", "失敗")
End Sub

投稿日時 - 2007-03-23 20:19:45

お礼

出来ました。
私などには書けないすばらしいコードに感激です。
nicotinismさんのような完璧なコードは書けるようにがんばります。
本当に助かりました。ありがとうございました。

投稿日時 - 2007-03-26 10:03:10

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問