freien Speicherplatz auslesen

Heilo Leute
habe im Archiv folgendes Problem gefunden:
Problem: Der freie Speicherplatz eines abzufragenden Laufwerks ist zu ermitteln.
StandardModule: Modul1


Sub Festplatte()
Dim var As Variant
Dim sLW As String, sSpace As String, sFile As String
sLW = InputBox("Laufwerk:", , "c")
If sLW = "" Then Exit Sub
sLW = Left(sLW, 1)
sFile = sLW & ":\dirliste.txt"
var = Shell("command.com /c dir *.xls >" & sFile, vbHide)
Application.Wait Now + TimeSerial(0, 0, 1)
Close
Open sFile For Input As #1
Do Until EOF(1)
Line Input #1, sSpace
Loop
Close
sSpace = Trim(sSpace)
sSpace = Right(sSpace, Len(sSpace) - InStr(sSpace, "  "))
sSpace = Trim(sSpace)
sSpace = Left(sSpace, InStr(sSpace, " ") - 1)
MsgBox "Freie MB auf Laufwerk " & sLW & ":" & vbLf & sSpace
Kill sFile
End Sub

Als ich es an meinem Rechner ausprobierte erhielt ich für die unterschieblichen Laufwerke immer wieder das selbe Ergebnis.
Hab ich da was verkehrt auf meinem Rechner?
Frage vom Schmausi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Schmausi,
so:

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function GetDiskFreeSpace Lib "kernel32.dll" Alias "GetDiskFreeSpaceA" ( _
    ByVal lpRootPathName As String, _
    ByRef lpSectorsPerCluster As Long, _
    ByRef lpBytesPerSector As Long, _
    ByRef lpNumberOfFreeClusters As Long, _
    ByRef lpTtoalNumberOfClusters As Long) As Long

Public Function Free_Space(strDir As String) As Single

    Dim lngSectors As Long, lngBytes As Long, lngFree As Long, lngTotal As Long
    Dim sngSectors As Single, sngBytes As Single, sngFree As Single

    '//retrieve information about the disk
    Call GetDiskFreeSpace(strDir, lngSectors, lngBytes, lngFree, lngTotal)

    '//change dimension
    sngSectors = lngSectors
    sngBytes = lngBytes
    sngFree = lngFree

    '//return free diskspace
    Free_Space = (sngSectors * sngBytes * sngFree) / 1024 / 1024 / 1024

End Function

Public Sub Test()
    MsgBox Free_Space("C:") & " GB"
End Sub

Gruß
Nepumuk

Sub Freiser_Speicher() Dim FSO As Object, LW As Object Set FSO = CreateObject("Scripting.filesystemobject") Set LW = FSO.drives("C:") MsgBox "Freier Speicherplatz auf " & LW.driveletter & Chr(13) & _ Round(LW.availablespace / 1024 / 1024 / 1024, 1) & " GB" End Sub

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

freien Speicherplatz auslesen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread