Excel VBA質問箱 IV

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

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


5666 / 13645 ツリー ←次へ | 前へ→

【49559】ツリー表示とリンク貼りしたファイルの自動更新 みるみる 07/6/11(月) 10:21 質問[未読]
【49564】Re:ツリー表示とリンク貼りしたファイルの... Jaka 07/6/11(月) 16:00 発言[未読]
【49567】Re:ツリー表示とリンク貼りしたファイルの... みるみる 07/6/11(月) 16:33 お礼[未読]
【49588】Re:ツリー表示とリンク貼りしたファイルの... Jaka 07/6/12(火) 10:21 発言[未読]
【49593】Re:ツリー表示とリンク貼りしたファイルの... みるみる 07/6/12(火) 11:28 お礼[未読]

【49559】ツリー表示とリンク貼りしたファイルの自...
質問  みるみる  - 07/6/11(月) 10:21 -

引用なし
パスワード
   超初心者です。
マクロ自体数週間前に初めて触ってみたくらいなのですが、仕事で作成するものにどうしてもマクロを組み込まないと便利に使えないものが出てきてしまいました。
色々な本やネット検索などを経て、わらをも掴む思いでこちらに投稿させていただいております。
アドバイスは超初心者でも分かりやすいものであれば大変ありがたいのですが、細かい説明が難しければヒントだけでもいただければ幸いです。

≪作成したいExcelファイル≫
ものすごく膨大なファイルの保存先ディレクトリをツリー表示した一覧表を作成したいと思っています。
そのファイルはたくさんの人たちで共有しているフォルダ内に保存されているため、移動や変更などが起きやすいものです。
ツリー表示は常に最新のものが欲しいため、ファイルを開くと同時に情報を自動更新でき、さらに表示されたファイル一つずつにその保存先へハイパーリンクをかけたいと思っております。(自動更新時にリンクが消去されないようにしたい)
ハイパーリンクをかけるファイルもいちいち一つずつ作業せず、マクロで設定できればとも考えています。

≪今まで試してみた内容≫
CMDを使って「tree /F」のコマンドを利用し、膨大な量のファイルに対するツリー表示を「.txt」ファイルで保存し、それをExcelの「テキストファイルウィザード」より開いてツリー表示をExcelに落とすことには成功しました。
ただ、Excelのマクロでどこまでその作業を設定できるのか分からず、もし設定できなければ他のどんな方法でツリー表示を作ればいいかも困っているところです。

正直ここから先、手を付けていいか分からないほど困っています・・・
もしかすると私がわざとややこしい方向に考えているだけで、もっと簡単に作成する方法があるのでしょうか?
初心者にはちょっと高度なものになるのは重々承知しておりますが、皆さんからのアドバイスを元に頑張って組みたいと思っておりますので、よろしくお願いします!

【49564】Re:ツリー表示とリンク貼りしたファイル...
発言  Jaka  - 07/6/11(月) 16:00 -

引用なし
パスワード
   ▼みるみる さん:
>≪今まで試してみた内容≫
>CMDを使って「tree /F」のコマンドを利用し、膨大な量のファイルに対するツリー表示を「.txt」ファイルで保存し、それをExcelの「テキストファイルウィザード」より開いてツリー表示をExcelに落とすことには成功しました。
>ただ、Excelのマクロでどこまでその作業を設定できるのか分からず、もし設定できなければ他のどんな方法でツリー表示を作ればいいかも困っているところです。
これをマクロで行えばいいのでしょうか?
もっともこれ以外は解らないけど...。

Sub trrtrr()
Dim Fpat As String, ComL As String, ReadData As String
Dim TB() As String, FileNo As Integer, i As Long, ii As Long
Dim DFoP As String
DFoP = CurDir()
Fpat = "C:\TrrFL.txt" 'テキスト1時保存場所
TrFld = "C:\"     'ツリー表示フォルダ
'カレントディレクトリーを移す。
CreateObject("WScript.Shell").CurrentDirectory = TrFld
'ドスコマンド
ComL = "COMMAND.COM /C tree>" & Fpat
Call Shell(ComL, vbHide)

FileNo = FreeFile
Open Fpat For Input As #FileNo
i = 0
Do Until EOF(FileNo)
  i = i + 1
  Line Input #FileNo, ReadData
Loop
Close #FileNo
DoEvents

ReDim Preserve TB(1 To i, 1 To 1)
ii = 0
FileNo = FreeFile
Open Fpat For Input As #FileNo
Do Until EOF(FileNo)
  ii = ii + 1
  Line Input #FileNo, TB(ii, 1)
Loop
Close #FileNo

'65536行以上の場合だった時を考えて取りあえず。
If i > 65536 Then
  MsgBox "プログラム改良必須"
  Erase TB
  Kill Fpat
  Exit Sub
End If

Range("A1").Resize(i).Value = TB
DoEvents
Erase TB
Kill Fpat '1時保存テキストを削除
DoEvents
End Sub

【49567】Re:ツリー表示とリンク貼りしたファイル...
お礼  みるみる  - 07/6/11(月) 16:33 -

引用なし
パスワード
   ▼Jaka さん:
>▼みるみる さん:
Jakaさん、早速のアドバイスをありがとうございます!!!

すぐに試してみました。
でもどうやらエラーの出るとき(特にファイルを開いて一度目のマクロ実行で)と、きちんと実行される時とあるようなんです(?_?)
デバックをしてみると、必ずこの行が黄色くマークされています。

>CreateObject("WScript.Shell").CurrentDirectory = TrFld

なにせまだまだマクロを勉強し始めたばかりで、私もすぐには原因が分からず、少し時間をかけてみてみようかと思っております。

もしまたいいアドバイスがあればぜひぜひお願いしたいのですが、私も頑張ってみます!
また再度、この作成作業上の質問を載せることもあると思いますので、見かけたらまた、よろしくお願いいたします。
本当にありがとうございます!

【49588】Re:ツリー表示とリンク貼りしたファイル...
発言  Jaka  - 07/6/12(火) 10:21 -

引用なし
パスワード
   エラーになる原因がなんとなく解りました。
ドスでのテキストファイルができるまでの時間。
これより、もっといい方法があると思います。
不安定すぎますね。すみません。

Sub dame()
Dim Fpat As String, ComL As String, ReadData As String
Dim TB() As String, FileNo As Integer, i As Long, ii As Long
Dim DFoP As String
DFoP = CurDir()
Fpat = "C:\TrrFL.txt" 'テキスト1時保存場所
TrFld = "C:\"     'ツリー表示フォルダ
'カレントディレクトリーを移す。
CreateObject("WScript.Shell").CurrentDirectory = TrFld
'ドスコマンド
ComL = "COMMAND.COM /C tree>" & Fpat
Call Shell(ComL, vbHide)

'DOSでTreeテキストができるまでの時間があいまい。
'自分の環境で15秒ぐらい待たないとダメでした。
'テキストができるまでの時間がよく解りませんでした。
'この辺があいまいで、すみません。     
Application.Wait Now + TimeValue("00:00:15")
DoEvents
Do Until Dir(Fpat) <> ""
  DoEvents    '←これもテキストができるまでの時間稼ぎ
Loop

FileNo = FreeFile
Open Fpat For Input As #FileNo
i = 0
Do Until EOF(FileNo)
  i = i + 1
  Line Input #FileNo, ReadData
Loop
Close #FileNo
DoEvents

ReDim Preserve TB(1 To i, 1 To 1)
ii = 0
FileNo = FreeFile
Open Fpat For Input As #FileNo
Do Until EOF(FileNo)
  ii = ii + 1
  Line Input #FileNo, TB(ii, 1)
Loop
Close #FileNo

'65536行以上の場合だった場合を考えて取りあえず。
If i > 65536 Then
  MsgBox "プログラム改良必須"
  Erase TB
  Kill Fpat
  Exit Sub
End If

Range("A1").Resize(i).Value = TB
DoEvents
Erase TB
Kill Fpat '1時保存テキストを削除
DoEvents
End Sub

【49593】Re:ツリー表示とリンク貼りしたファイル...
お礼  みるみる  - 07/6/12(火) 11:28 -

引用なし
パスワード
   ▼Jaka さん:
おぉ!!
本当にエラーが出なくなりました!!
何度も何度も・・・本当にありがとうございました!!

ここから細かい修正と、自動ハイパーリンク貼りを頑張ってみたいと思います(*^_^*)
本当に助かります!!

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