Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
876to880
876to880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Fortschrittsanzeige

Fortschrittsanzeige
19.06.2007 08:06:16
pain007
Sehr geehrter VBA und Excel Profis!
Ich habe ein Programm aus mehreren bereits bestehenden Quellcodes "zusammengebastelt", welches Dateien eines gewählten Ordner ausliest und diese nach Namen, Speicherort, Hyperlink usw. auflistet.
Da es bei manchen Einlesevorgängen sehr lange dauert wäre eine Fortschrittsbalken von Vorteil.
Leider habe ich sehr, sehr wenig Ahnung im VBA. Vielleicht könnt Ihr mir ja helfen diesen Balken einzubauen.
Hier der Quellcode:
Dim n
Dim dname(65000)
Dim dordner(65000)
Dim dcreated(65000)
Dim dpfad(65000)
Dim dlast(65000)
Dim dsize(65000)

Sub NeuEinlesen()
Set MyShell = CreateObject("wscript.shell")
Set MyFiles = CreateObject("Scripting.FileSystemObject")
Set Appshell = CreateObject("Shell.Application")
On Error Resume Next
Set AppFolder = Appshell.BrowseForFolder(0, "", &H1, 17)
verz = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
If Err.Number > 0 Then
i = InStr(AppFolder, ":")
verz = Mid(AppFolder, i - 1, 1) & ":\"
End If
If verz = "" Then Exit Sub
If n = 0 Then
Range("A3").Select
Range(Selection, Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
End If
Set drive = MyFiles.GetFolder(verz)
Set dat = drive.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = drive.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
Next
Search drive
For x = 1 To n
Cells(x + 2, 1).Value = MyFiles.GetBaseName(dpfad(x))
Cells(x + 2, 2).Value = MyFiles.GetExtensionName(dpfad(x))
Cells(x + 2, 4).Value = dordner(x)
Cells(x + 2, 5).Value = Int(dsize(x) / 1024)
Cells(x + 2, 6).Value = DateValue(Date) - DateValue(dcreated(x))
Cells(x + 2, 7).Value = DateValue(Date) - DateValue(dlast(x))
Cells(x + 2, 8).Value = dpfad(x)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x + 2, 9), Address:= _
dpfad(x), TextToDisplay:=dname(x)
Next
Application.ScreenUpdating = True
m = MsgBox(n & " Dateien eingetragen." & Chr(13) & "Weitere Daten hinzufügen?", 4)
If m = 6 Then NeuEinlesen
Range("A3").Select
Range(Selection, Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Sort key1:=Range("D3"), order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, header:=xlNo
Range("A2:I2").Select
With Worksheets("Tabelle1")
If Not .AutoFilterMode Then
Selection.AutoFilter
End If
End With
Range("A2").Select
n = 0
End Sub



Sub Search(ByVal StartFolder)
Set Weitere = StartFolder.SubFolders
For Each AktuellerOrdner In Weitere
Set dat = AktuellerOrdner.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = AktuellerOrdner.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
Next
Search AktuellerOrdner
Next
End Sub


Ich bedanke mich für Eure Hilfe vielmals im Voraus,
mfg pain007

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fortschrittsanzeige
19.06.2007 09:13:25
Rudi
Hallo,

Da es bei manchen Einlesevorgängen sehr lange dauert wäre eine Fortschrittsbalken von Vorteil.


das dauert nur noch länger.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Fortschrittsanzeige, aber warum nicht?
19.06.2007 09:48:00
pain007
Hallo
Wäre es ein großer Aufwand, eine Fortschrittsanzeige einzubauen? Leider kenne ich mich nicht so gut im VBA aus.
Auch wenn der Einlesevorgang dadurch unnötig verlängert wird, wäre es trotzdem von großem Interesse diese einzubauen.
mfg pain007

AW: Fortschrittsanzeige, aber warum nicht?
19.06.2007 09:58:44
BG
Hi Pain
falls es dir keine zu grosse Pein macht, hier in der Online-Recherche bekommst du bei Eingabe von "Fortschritt" , 170 Beiträge
Einer wird bestimmt für dich dabei sein!
mfg BG

Anzeige
AW: Fortschrittsanzeige
19.06.2007 22:57:58
Daniel
Hi
der einfachst Weg, einen Fortschrittsbalken zu erzeugen ist, an bestimmtern Stellen in den Code folgendes einzubauen:

Sub irgendwas()
application.Statusbar = "X" 'beim ersten mal
application.statusbar = application.statusbar & "X"
application.statusbar = application.statusbar & "X"
application.statusbar = false '(bei makro-Ende Statusbar wieder für das System freigeben)
End Sub


Gruß, Daniel
(statt "x" kannst du dir auch irgendein passenderes Zeichen aus dem Tahoma-Schriftsatz aussuchen)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige