明日の朝消します / 2009年11月24日(火)
Option Explicit


Public rootStr As String
Public Rowy As Integer
Public bolFileShow As Boolean
Public myInput

Sub showFolderCnt1()


On Error GoTo ErrorAccess


Dim rootStr As String



Dim myMsg As String

If Range("A1") <> "" Then



Cells.Select
Selection.ClearContents
Selection.ClearFormats
Range("A1").Select
End If
myMsg = "表示開始したい一番上位のディレクトリを指定してください" & Chr(13) & "例1 ---> C:\TEST" & Chr(13) & "例2 ---> \\NetWrk" & Chr(13) & "例3 ---> D:\Test"

myInput = InputBox(myMsg, "ツリー表示上位フォルダ指定")

If myInput = "" Then
MsgBox "作成時は上位フォルダを指定してください"
Exit Sub
Else
bolFileShow = False
If MsgBox("フォルダ以外(ファイル構成)も表示しますか?" & Chr(13) & "!!サブフォルダが多い場合エライ時間がかかります", vbYesNo) = vbYes Then
bolFileShow = True
End If

End If

Cells(1, "A").Value = myInput & " ←ここのフォルダから第三階層までしか取得&表示していません"

rootStr = myInput


If Right(rootStr, 1) <> "\" Then
rootStr = rootStr & "\"
End If


Dim folName As String
Dim ErrNo As Integer


ErrNo = 1


'一番最初のフォルダ
folName = Dir(rootStr, vbDirectory)


Dim Cnt As Integer


Cnt = 0

Do While folName <> ""

If folName <> "." And folName <> ".." Then

'フォルダ名のみカウントする

'(※dir関数はフォルダが存在しない場合ファイルを表示してしまうので)
If (GetAttr(rootStr & "\" & folName) And vbDirectory) = vbDirectory Then

Cnt = Cnt + 1

End If

End If

SetNxtDir:
ErrNo = 2
folName = Dir '次のフォルダへ

Loop


'B1セルにフォルダ数を表示
'Cells(1, "").Value = "直下のフォルダ数: " & Cnt


Call showFolLst

Exit Sub

ErrorAccess:
If ErrNo = 1 Then
MsgBox "指定フォルダにアクセス権限がないので下層に進めません"
Else
Resume SetNxtDir
End If
End Sub


Sub showFolLst()


rootStr = myInput

If Right(rootStr, 1) <> "\" Then
rootStr = rootStr & "\"
End If


'フォルダ数分ループ

Dim folName() As String
Dim folNamei
Dim iLoop As Integer

'一番最初のフォルダ
folNamei = Dir(rootStr, vbDirectory)


Rowy = 2 '2行目


On Error GoTo ErrAccess


Do While folNamei <> ""
Dim i As Integer
Dim ErrNo As Integer 'エラー箇所判断
ReDim Preserve folName(i)

folName(i) = folNamei

folNamei = Dir '次のフォルダへ
DirSet:
i = i + 1
Loop


For iLoop = 0 To UBound(folName)
If folName(iLoop) <> "." And folName(iLoop) <> ".." Then


'フォルダのみ表示
If (GetAttr(rootStr & folName(iLoop)) And vbDirectory) = vbDirectory Then

'第一階層をB列y行に表示
Cells(Rowy, "A").Value = "├───"
Cells(Rowy, "B").Value = folName(iLoop)

Range("B" & Rowy).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
rootStr & folName(iLoop), TextToDisplay:=folName(iLoop)


Rowy = Rowy + 1

Dim lngRt As Long

'さらに下層のフォルダを検索
lngRt = folsrch(rootStr & folName(iLoop))
ElseIf folName(iLoop) = "★" Then
'アクセス権限なしと表示
Cells(Rowy, "A").Value = "├───"
Cells(Rowy, "B").Value = "アクセス権限なし"

Rowy = Rowy + 1

ElseIf bolFileShow = True Then
Cells(Rowy, "A").Value = "├───"
Cells(Rowy, "B").Value = folName(iLoop)

Rowy = Rowy + 1

End If


End If
NxtDir:

Next


Cells(Rowy, "B").Value = "/" '←終了


'Call showLine1

Exit Sub

ErrAccess:
If ErrNo = 1 Then
folName(i) = "★"
Resume DirSet
Else
Resume NxtDir
End If

End Sub

Public Function folsrch(shFolPAth As String) As Long
Dim fldName2 As String
Dim ErrNo As Integer 'エラー場所格納
Dim folName2() As String

On Error GoTo ErrAccess


shFolPAth = shFolPAth & "\"

ErrNo = 1

'二番目のフォルダ内検索
fldName2 = Dir(shFolPAth, vbDirectory)

On Error GoTo ErrAccess

Dim i As Integer
Do While fldName2 <> ""



ReDim Preserve folName2(i)

folName2(i) = fldName2

fldName2 = Dir '次のフォルダへ
DirSet:
i = i + 1
Loop

Dim iLoop As Integer
For iLoop = 0 To UBound(folName2)

'''

If folName2(iLoop) <> "." And folName2(iLoop) <> ".." Then
ErrNo = 2
'フォルダのみ表示
If (GetAttr(shFolPAth & folName2(iLoop)) And vbDirectory) = vbDirectory Then
'A列にツリーの続きを書く
Cells(Rowy, "A").Value = "|"
'B列y行+1に表示
Cells(Rowy, "B").Value = "└───"
Cells(Rowy, "C").Value = folName2(iLoop)
'ハイパーリンクの設定
Range("C" & Rowy).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
shFolPAth & folName2(iLoop), TextToDisplay:=folName2(iLoop)


'これをグローバルに持ってくる
Rowy = Rowy + 1


Dim lngRt As Long

'さらに下層のフォルダを検索
lngRt = folsrch2(shFolPAth & folName2(iLoop))

ElseIf folName2(iLoop) = "★" Then
'アクセス権限なしと表示
Cells(Rowy, "A").Value = "├───"
Cells(Rowy, "B").Value = "アクセス権限なし"

Rowy = Rowy + 1

ElseIf bolFileShow = True Then
'A列にツリーの続きを書く
Cells(Rowy, "A").Value = "|"
'B列y行+1に表示
Cells(Rowy, "B").Value = "└───"
Cells(Rowy, "C").Value = folName2(iLoop)

Rowy = Rowy + 1



End If


End If

'''
NxtDir:
Next



folsrch = 0
Exit Function

ErrAccess:
If ErrNo = 1 Then
folName2(i) = "★"
Resume DirSet
Else
Resume NxtDir
End If


End Function

'同じ関数を流用してべた書きしてます。
Public Function folsrch2(shFolPAth As String) As Long
Dim fldName3 As String
Dim ErrNo As Integer 'エラー場所格納
Dim folName3() As String

On Error GoTo ErrAccess


shFolPAth = shFolPAth & "\"

ErrNo = 1

'二番目のフォルダ内検索
fldName3 = Dir(shFolPAth, vbDirectory)

On Error GoTo ErrAccess

Dim i As Integer
Do While fldName3 <> ""



ReDim Preserve folName3(i)

folName3(i) = fldName3

fldName3 = Dir '次のフォルダへ
DirSet:
i = i + 1
Loop

Dim iLoop As Integer
For iLoop = 0 To UBound(folName3)

'''

If folName3(iLoop) <> "." And folName3(iLoop) <> ".." Then
ErrNo = 2
'フォルダのみ表示
If (GetAttr(shFolPAth & folName3(iLoop)) And vbDirectory) = vbDirectory Then

'A列にツリーの続きを書く
Cells(Rowy, "A").Value = "|"
Cells(Rowy, "B").Value = "|"

'B列y行+1に表示
Cells(Rowy, "C").Value = "└───"
Cells(Rowy, "D").Value = folName3(iLoop)

'ハイパーリンクの設定
Range("D" & Rowy).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
shFolPAth & folName3(iLoop), TextToDisplay:=folName3(iLoop)

'これをグローバルに持ってくる
Rowy = Rowy + 1

'サブフォルダがあったという事なので、サブフォルダ配列に値をセットして渡す
'
' Dim lngRt As Long
'
' 'さらに下層のフォルダを検索
' lngRt = folsrch3(rootStr & folName(iLoop))

ElseIf folName3(iLoop) = "★" Then
'アクセス権限なしと表示
Cells(Rowy, "A").Value = "├───"
Cells(Rowy, "C").Value = "アクセス権限なし"

Rowy = Rowy + 1

ElseIf bolFileShow = True Then
'A列にツリーの続きを書く
Cells(Rowy, "A").Value = "|"
Cells(Rowy, "B").Value = "|"

'B列y行+1に表示
Cells(Rowy, "C").Value = "└───"
Cells(Rowy, "D").Value = folName3(iLoop)
Rowy = Rowy + 1
End If


End If

'''
NxtDir:
Next


folsrch2 = 0
Exit Function

ErrAccess:
If ErrNo = 1 Then
folName3(i) = "★"
Resume DirSet
Else
Resume NxtDir
End If

End Function
 
   
Posted at 00:08/ この記事のURL
コメント(0)
安定 / 2009年10月19日(月)
安定なんて言葉30になったばかりの頃は全く求めていなかった。
バカだ。
まだまだ、あとちょっと・・・なんて思っていた。

安定ほど自由なものはない。
今さら、気がついた。

気がついた時には、大不況の波にのまれ、このザマ。
笑える。
自分がもう一人いたら、きっと、ざまぁみろと笑って見ているだろう。

願いがかなうのなら、平凡で平和という名の安定が欲しい。
安定した仕事に就いて、沢山、稼ぎたい。

バカだ。
くだらない事にこだわって、まだまだと思っていた自分は、
バカだ。
 
   
Posted at 21:22/ この記事のURL
コメント(0)
どうも私は / 2009年06月06日(土)

どうも私は、あれ以来、死ぬことばかりを考えている見たいだ。

私、死ぬのか?

目の前に付き抜ける空はないような気がする。
果ての際限のない高い壁ならば、容易に想像・・・いや、想像しなくても常に存在しているように思う。
 
   
Posted at 17:42 / 閑話 / この記事のURL
コメント(0)
さようなら / 2009年04月26日(日)
ベルタさんとお別れです。


サヨナラベルタさん(涙)



引っ越しはなんの感慨もなかったけれど、
愛車とのお別れはぐっときますね・・・。
 
   
Posted at 17:41 / 閑話 / この記事のURL
コメント(0)
苦しい / 2009年04月11日(土)
自分が苦しいから、
人にもこれ以上ツライ状況を言ってはいけないと、ある嘘をついたら、今度は自分が、何倍も苦しくなって、本当の事を二人だけに伝えたら、つまり、自分が嘘をついていた事を告白した事になって、ますます苦しくなってしまった。


もう、つらすぎ。

生きる事は、苦しいですね。


馬鹿だ、私は。
 
   
Posted at 12:41 / 閑話 / この記事のURL
コメント(0)
仕事 / 2009年04月04日(土)
もう一度、

仕事も、人間関係も

プライベートもそれなりに充実した日々


そんな日々がやってきてほしい。

私は、作家になりたい。

もう、20年も前から思っている。

一時は、その卵みたいな事をしてお金も頂いていたけれど、

ここ数年はなにもしていない。

言葉も、手法も忘れかけて・・・

引っ越したら

ちゃんと

今度は通信で勉強をしようと思う。

私は、小説家になりたい。

神様。
 
   
Posted at 00:55 / 閑話 / この記事のURL
コメント(0)
which / 2009年04月04日(土)

終わるのか

始まるのか

わからない


終わるものもあれば

始まるものもある

でも、それは

終わることの必然として続いているだけで

本当の始まりではないような気がする

つまり

終りの先というか

終りの続き

ただの、続き

スタートなんかじゃない

まだ終わりの続きを漠然とさまよっているだけな気がする

仕事も、プライベートも、夢も、

まだ何も

ただの終わりの続きをさまよっているだけ

そんな気がする
 
   
Posted at 00:48 / 閑話 / この記事のURL
コメント(0)
辛い / 2009年03月22日(日)
水曜日の顔合わせ(面談)の結果が、
担当者さんがその後に言った話だと、
「早くて明日(木曜日)、遅くても月曜日には」という事だった。
木曜日は連絡がなかった。で、金曜日から今日までが三連休だから、
明日の月曜日に結果の連絡が来る筈。

もう、苦しくて仕方がない。
また2月18日のように期待させておいて、残念なお知らせが
来るんじゃないかと。。。

今日は、雨のせいか鬱が酷い。
正直、ネガティブな事しか浮かばない。

消えたい。
つまり、死にたい。
薬飲んで意識がなくなるみたいに、
眠るように死ねたらなんて楽なんだろうって思う。


もう、進む方向が分からない。
だって、今月でここを退去するって不動産屋にいっちゃったし。
もう、本当に先がない。

ねぇちゃん、妹、ごめんなさい。

生きていたって、春なんか、もう、来ない気がする。
だって、八方塞がりだもん、厄年だもん。

こんな時に、ちゃんとした親がいればいいのだけれど、
私にそんな親はいない。

家族か。。。羨ましいなぁ。。。
戻る場所があるって、一番大切で幸せな事だと思う。

あぁ。。。辛い、辛い、苦しい、苦しい。。。

神様。
 
   
Posted at 17:33 / ぐち / この記事のURL
コメント(0)
Lucky Happy Day has come きっと。 / 2009年03月21日(土)
誕生日が過ぎました。
まだ仕事が決まっていません。

月曜日に一社、正社員ではありまえんが、
結果が出ます。

内容も、給料も、人間関係も、全てにおいて働きたい!
と、思える場所ですが、果たして採用してもらえるのでしょうか。

水曜日に顔合わせという名の面談をしました。
結果は早くて木曜日(翌日)遅くても月曜日と言われました。

木曜日は返事がありませんでした。
金曜からは3連休なので、
あとは月曜日しかありません。

月曜日、私はどうなるのでしょうか?
こんな事を書くと、死亡フラグみたいでいやですね。
いえいえ、ポジティブにこんなに長い間耐えたのだから、
採用という結果を期待したいものです。。。

ちょっと酔ってますね。。。

そして疲れています。

月曜日の為の今までだったと思えるような、
素敵な一日になると良いのですが。。。

11月20日からもう4か月も働いていません。
働くってどんなに生甲斐があって素敵な事だったか。。。

4月1日には新しい職場で働いていたいです。。。

神様。
 
   
Posted at 18:48 / 閑話 / この記事のURL
コメント(0)
春 / 2009年03月03日(火)
前の日記に春の気配なんてタイトルを付けたけれど、
春はとーーーーーーーーーーくに感じる今日この頃・・・

私、自分の誕生日にもまだ働いていない気がする・・・

もう、寒さで凍死しそうです。
 
   
Posted at 19:43 / ぐち / この記事のURL
コメント(0)
P R
  | 前へ  
 
GMO MadiaHoldings, Inc.