ExcelかAccessのVBAでドライブの容量取得

社内のいくつかのサーバーの各ドライブごとの容量を調べたいのですが・・・。

(1)ドライブの数がトータルで４０個くらいあります
(2)週に一度くらい確認しています
(3)各サーバーはネットワークでつながっています

上記のような状況のため、ＶＢＡなどで自動取得できないかと悩んでいます。
（現在はサーバのマイコンピュータを見て、リストに記入・・・とやっています）

ＶＢＡでネットワークドライブの割り当てを行い、容量を取得、その後割り当てを解除・・・という形で行おうと思ったのですが、
ＶＢＡで割り当てを行う方法がわかりません。
（FileSystemObjectでDriveのサイズは取得できます）

また、割り当てを行わずに容量を取得する方法があるのでしたらそれでもいいと思うのですが、調べても分かりませんでした。

できればファイルに結果を残したいので、エクセルかアクセスのＶＢＡでできたらなぁと思っています。
（またスキルの面からも、ＶＢＡくらいしか使えません）

何か良いやり方があれば、教えていただけないでしょうか？
よろしくお願い致します。

＊環境：windows2000・office2000

No.2 ベストアンサー 回答者： BLUEPIXY 回答日時： 2006/04/20 19:08

>FileSystemObjectでDriveのサイズは取得できます

であれば、同じように
Set oWSHNet = CreateObject("WScript.Network")
oWSHNet.MapNetworkDrive "Z:", "\\SERVER1\DRIVE1" ',,"USER","PASSWORD"
で割り当てることができます。
ユーザー指定が必要な場合は、コメント解除して下さい。

解除する場合は
oWSHNet.RemoveNetworkDrive "Z:"
で解除できます。

この回答へのお礼

ありがとうございますー。できました！！
1の方のＤＯＳのコマンドと両方やってみたのですが、ＤＯＳ窓がぴよぴよしないので、こちらで進めてみることにしました。
ただ、On Error Resume Nextを記載しても、ネットワークに接続できないと処理が止まってしまうのが困り者です・・・。
それでも、とっても時間が短縮できて満足です。

お礼日時：2006/04/21 16:06

No.5 回答者： nicotinism 回答日時： 2006/04/21 21:36

追伸です。

Fire Wall でも蹴られますので実用的では無いようです・・・

申し訳ない。

この回答へのお礼

おはようございます。
自分のＰＣのドライブだと取得できるのですが、確かにネットワークは取得できないみたいですね・・・。
頑張ってみましたが、駄目でしたが、とても勉強になりました。
何度もアドバイスいただき、本当にどうもありがとうございました！

お礼日時：2006/04/24 09:11

No.4 回答者： nicotinism 回答日時： 2006/04/21 17:18

前述のリンク先は昨日見つけていたのですが、もうちょっと何とかしようとして

うまく行かず、とりあえずリンクだけ載せました。
当初 VBA内に記述しようと思ったのですが、結局 WSH と WMI が肝なので
こんな風になっちゃいました・・・。
☆ ユーザー名・パスワードの設定を何とかしたかったのですが妥協作です ☆

以下をコピーして、適当なファイル名.VBS で保存して試してみてください。
結果を教えてもらえると幸いです。Win2000以上のOSで動くとは思いますが？

↓ここから
On Error Resume Next
'リストアップされたマシンのディスク空き容量を調べます。
'各マシンでのサービス・マシンの管理者権限設定が必要。
'同一フォルダにDiskSizeLog.csvが出来ます
Dim srvName(10)
srvName(0) = "."'自PC
srvName(1) = "Server01"
srvName(2) = "dummy"
'てな具合に配列に入れる
Set objShell = CreateObject("Wscript.Shell")
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objNet = Wscript.CreateObject("Wscript.Network")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Do Until srvName(i) = ""
If srvName(i) = "." Then
strComputer = objNet.ComputerName
Else
strComputer = srvName(i)
End If

Call execPart(strComputer)
If Err.Number = 70 Then'書き込み出来ない場合３回トライして諦める
Do until i>4
Wscript.Sleep 10 * 1000 + 5 * 1000 * Rnd
i = i + 1
Call execPart(strComputer)
Loop
Elseif Err.Number <> 0 Then
Call errSrv
End If
i = i + 1
Loop
rtnVal = objShell.PopUp("終了しました", 3)
Wscript.Close


Sub execPart(strComputer)
Set objTxtOut = _
objFso.OpenTextFile(objShell.CurrentDirectory & "\DiskSizeLog.csv",ForAppending,True)

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = 3")
For Each objDisk in colDisks
txtOut = Date & "," & _
"""" & strComputer & """," &_
"""" & objDisk.DeviceID & """," &_
objDisk.Size & "," &_
objDisk.FreeSpace
objTxtOut.Write (txtOut)
objTxtOut.Write vbCrLf
Next
objTxtOut.close()
End Sub


Sub errSrv()
Set objTxtOut = _
objFso.OpenTextFile(objShell.CurrentDirectory & "\DiskSizeLog.csv",ForAppending,True)
txtOut = Date & "," & _
"""" & strComputer & """," &_
"""" & "unKnown Err.No " & Err.Number & " " & Err.description & """," &_
0 & "," &_
0
objTxtOut.Write (txtOut)
objTxtOut.Write vbCrLf
objTxtOut.close()
Err.Clear
End Sub

No.3 回答者： nicotinism 回答日時： 2006/04/21 12:35

ネットワークの構成や権限が分からないので・・・

ドライブの空き領域率を確認する方法はありますか
http://www.microsoft.com/japan/technet/scriptcen …
は参考になりませんか？
strComputer = "." を strComputer = "サーバー名" とすれば
各ドライブの容量を拾ってこれる『場合』もあります。

この回答へのお礼

ご回答ありがとうございます。
これはＶＢＳのコード・・・ということになるんですよね？
ＶＢＡだけでは結局無理って感じですね・・・。
ちょっとやってみたのですが、やっぱり参照設定とかいるんでしょうか？上手く動きませんでした。
まだまだ勉強しないといけないことがありそうです。

お礼日時：2006/04/21 16:12

No.1 回答者： kokorone 回答日時： 2006/04/20 15:19

ドライブ割り当てのＤＯＳコマンドは、”netuse”です。

これをＳＨＥＬＬ関数で、実行すればいいでしょう。
空き容量は、参照ＵＲＬを参考にしてください。

参考URL：http://www.moug.net/tech/acvba/0020001.htm

この回答へのお礼

ご回答、ありがとうございます！
DOSはあまり使ったことがなくて、ちょっと四苦八苦しちゃいましたが、無事に割り当てができました！
（念のため、コードを貼っておきます）

Sub test()
Dim a
　　a = "NET USE Z: \\server\C$"
　　Call Shell("CMD.exe /c " & a)
　　a = "Net Use Z: /delete"
　　Call Shell("CMD.exe /c " & a)
End Sub

お礼日時：2006/04/21 15:56