Nur neue Datein Kopieren mit fso

Computer: Software & Programmierung Visual Basic
#41

Hallo Rainer,

ich habe immernoch das problem das die Datumsprüfung nicht
funktioniert. Die Prüfung ob der ordner neuer als zb. 4 Wochen ist bezieht sich aber auf die Datei oder ? oder wird der Ordner geprüft ?
Datem = 1

aber es wird immer der ganze Ordner mit allen Unterordnern und alten Datein Kopiert.

Sub ScanDir(ScanPfad)
 Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
 Dim ZielPfad As String
 Dim ZielDatei

 Set PathObject = MyFSO.GetFolder(ScanPfad)
 Set FileObject = PathObject.Files

 For Each FileNow In FileObject
 ZielDatei = Ziel + "\" + Right(FileNow, Len(FileNow) - Len(Quelle) - 1)
 If PathFileExists(ZielDatei) = 0 Then
 FileCopy FileNow, ZielDatei
 Form1.Refresh
 DoEvents
 Else
 If DateM = 0 Then
 Set f1 = MyFSO.GetFile(FileNow)
 dt1 = f1.DateLastModified
 Set f2 = MyFSO.GetFile(ZielDatei)
 dt2 = f2.DateLastModified
 Form1.Refresh
 DoEvents

 If dt1 dt2 Then
 If DateDiff("s", dt2, dt1) \> 0 Then
 On Error Resume Next
 FileCopy FileNow, ZielDatei
 End If
 End If


 Else
 Set f1 = MyFSO.GetFile(FileNow)
 dt1 = f1.DateLastModified
 Set f2 = MyFSO.GetFile(ZielDatei)
 dt2 = f2.DateLastModified
 dt3 = f1.DateCreated
 Form1.Refresh
 DoEvents

 If dt1 dt2 Then
 If DateDiff("s", dt2, dt1) \> 0 Then
 If DateDiff("ww", dt3, Date) 


mfg Jonny

\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_\_

Ih hab' mal 'n Pre-Tag eingebaut. :smile: 
Gruß, Rainer
#42

Hi Joe,

ich kann keinen Fehler entdecken.

Setz doch mal einen Stoppunkt und gehe das Programm im Einzelschritt durch. Dann kannst Du die Werte beobachten und findest vermutlich die Ursache.

Was ich z.B. nicht sehen kann ist, ob

If DateM = 0 Then

funktioniert, ich sehe die Deklaration nicht.

Wenn DateM nicht 0 sondern „0“ (String) ist, läuft das Programm schon anders. Im Einzelschritt kannst Du auch an der Stelle:

If DateDiff("ww", dt3, Date) 
den Inhalt von dt3 prüfen. Du kannst das für die Testphase auch mal nach ...


    
    dd = DateDiff("ww", dt3, Date)
    If dd 
    ändern und den Inhalt von dd prüfen, ob der bei einer älteren Datei wirklich \> 3 ist. 
    
    Ohne debuggen finde ich den Fehler nicht. Mit bloßem Auge ist der für mich nicht sichtbar. Da habe ich wohl gerade Scheuklappen auf.
    
    Gruß, Rainer
#43

hi,
wie mache ich das mit dem StopPunkt ?

Das Problem was ich habe ist:
Die Prüfung des Create Datum passiert mit dem Ordner aber nicht mit den Datein :confused: Ich brauche aber eine Prüfung der Datein ob diese älter als X sind und wenn ja nicht kopieren ?

könntest mir dabei nochmal helfen ?

Sub ScanDir(ScanPfad)
Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
Dim ZielPfad As String
Dim ZielDatei

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) - Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then
FileCopy FileNow, ZielDatei
Form1.Refresh
DoEvents
Else
If DateM = 0 Then
Set f1 = MyFSO.GetFile(FileNow)
dt1 = f1.DateLastModified
Set f2 = MyFSO.GetFile(ZielDatei)
dt2 = f2.DateLastModified
Form1.Refresh
DoEvents

If dt1 dt2 Then
If DateDiff(„s“, dt2, dt1) > 0 Then
On Error Resume Next
FileCopy FileNow, ZielDatei
End If
End If

Else
Set f1 = MyFSO.GetFile(FileNow)
dt1 = f1.DateLastModified
Set f2 = MyFSO.GetFile(ZielDatei)
dt2 = f2.DateLastModified
dt3 = f1.DateCreated
Form1.Refresh
DoEvents

If dt1 dt2 Then
If DateDiff(„s“, dt2, dt1) > 0 Then
If DateDiff(„ww“, dt3, Date)

#44

Hi Joe,

wie mache ich das mit dem StopPunkt ?

Du hast bisher auf die beste Funktion von VB verzichtet? Dann wird es Dir gleich erst richtig Spaß machen. :smile:

Gehe zu Deinem Code und sieh Dir dort mal den linken Rand des Fensters an, der ist breiter als üblich. Da ist ein grauer Rand, der wenigstens 20 Pixel breit ist. Such Dir eine Zeile, in der das Programm angehalten werden soll und klicke in dieser Zeile auf den grauen Rand. Du bekommst einen Punkt und die Zeile wird markliert.

Dein Programm läuft dann bis zu dieser Zeile und wird dort angehalten. Vor der Zeile wird Dir mit einem gelben Pfeil der Programmpointer gezeigt. Der Pointer ist verschiebbar, Du kannst bei dedarf das Programm auch an einer anderen Stelle in dieser Prozedur fortsetzen.

Du kannst das Programm mit ‚F8‘ den nächsten Befehl ausführen lassen, das Programm Schritt für Schritt abarbeiten.

Stellst Du den Mauszeiger auf eine Variable, wird Dir in einem Tooltipptext der Inhalt der Variablen angezeigt. Du kannst verfolgen, wie sich die Inhalte der Variablen verändern und welcher Programmschritt warum wann durchgeführt wird. So findet man jeden Fehler.

Das Problem was ich habe ist:
Die Prüfung des Create Datum passiert mit dem Ordner aber
nicht mit den Datein :confused: Ich brauche aber eine Prüfung der
Datein ob diese älter als X sind und wenn ja nicht kopieren ?

Wie ich den Code sehe, wird vor jeder Datei geprüft, wie alt sie ist. Ich sehe den Fehler nicht. Du findest den jetzt sicher schnell.

Dein Problem habe ich schon verstanden, das kann ich aber im Code nicht finden.

Gruß, Rainer

#45

Hi Rainer,

Es lebe der „StopPunkt“ !!! Danke.

Ich habe den Quelltext angepasst und ZACK alle datein älter als 4 Monate werde (wenn ich es wünsche) ausgelassen.

Die Datein werden nicht kopiert aber die Ordner werden trotzdem angelegt :confused: Einfachst Lösung wäre einfach den Ordner komplett zu scannen und alle Unterordner die leer sind zu löschen.
wie müsste das aussehen ?

Danke

Sub ScanDir(ScanPfad)
Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
Dim ZielPfad As String
Dim ZielDatei

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) - Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then

If DateM = 0 Then

dt3 = f1.DateCreated
If DateDiff(„ww“, dt3, Date) dt2 Then
If DateDiff(„s“, dt2, dt1) > 0 Then
On Error Resume Next
FileCopy FileNow, ZielDatei
End If
End If
End If
End If
End If
End If
End If
Next

Set SubFolders = PathObject.SubFolders
For Each SubFoldersNow In SubFolders
ZielPfad = Ziel + „“ + Right(SubFoldersNow, Len(SubFoldersNow) - Len(Quelle) - 1)
If PathFileExists(ZielPfad) = 0 Then
MkDir ZielPfad
End If
ScanDir (SubFoldersNow.ParentFolder + „“ + SubFoldersNow.Name)
Next
End Sub

#46

Hallo Joe,

Es lebe der „StopPunkt“ !!! Danke.

sag ich doch! :smile:

Ich habe den Quelltext angepasst und ZACK alle datein älter
als 4 Monate werde (wenn ich es wünsche) ausgelassen.

Die Datein werden nicht kopiert aber die Ordner werden
trotzdem angelegt :confused: Einfachst Lösung wäre einfach den Ordner
komplett zu scannen und alle Unterordner die leer sind zu
löschen.
wie müsste das aussehen ?

Ja, denke ich auch. Das Verzeichnis wird angelegt, Du weißt ja noch nicht, ob etwas hinein kommt. Dann werden die Dateien kopiert …

Sub ScanDir(ScanPfad)
Dim PathObject, FileObject, FileNow, SubFolders,
SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
Dim ZielPfad As String
Dim ZielDatei

Dim n As Long

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

… Hier kommt gleich die Kopierschleife, also erst mal einen Counter auf Null setzen:

n = 0

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) -
Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then

If DateM = 0 Then

dt3 = f1.DateCreated
If DateDiff(„ww“, dt3, Date) dt2 Then
If DateDiff(„s“, dt2, dt1) > 0 Then
On Error Resume Next
FileCopy FileNow, ZielDatei

n = n + 1

End If
End If
End If
End If
End If
End If
End If
Next

… und hier sind entweder Dateien in das Verzeichnis kopiert oder nicht.

If n = 0 Then
RmDir ZielPfad
End If

Wenn nichts kopiert wurde, wird das Verzeichnis wieder entfernt.

Set SubFolders = PathObject.SubFolders
For Each SubFoldersNow In SubFolders
ZielPfad = Ziel + „“ + Right(SubFoldersNow,
Len(SubFoldersNow) - Len(Quelle) - 1)
If PathFileExists(ZielPfad) = 0 Then
MkDir ZielPfad
End If
ScanDir (SubFoldersNow.ParentFolder + „“ +
SubFoldersNow.Name)
Next
End Sub

Wenn ich nichts falsch gemacht habe und keine Variablen verwechselt, soll das so gehen. :smile:

Gruß, Rainer

#47

Hmmmmm,
ZielPfad gibt es an der stellen nicht mehr:/
hmm

ich habe schon fast alles Positionen ausprobiert aber leider ohne
erfolg.
wo könnte das mit dem funktionieren.

If n = 0 Then
RmDir ZielPfad
End If

Sub ScanDir(ScanPfad)
Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
Dim ZielPfad As String
Dim ZielDatei
Dim n As Long

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

n = 0

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) - Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then

Set f1 = MyFSO.GetFile(FileNow)
dt3 = f1.DateCreated
If DateM = 0 Then
If DateDiff(„m“, dt3, Date) dt2 Then
If DateDiff(„s“, dt2, dt1) > 0 Then
On Error Resume Next
FileCopy FileNow, ZielDatei
n = n + 1

End If
End If
Else
Form1.Refresh
DoEvents
End If
End If
Next

Set SubFolders = PathObject.SubFolders
For Each SubFoldersNow In SubFolders
ZielPfad = Ziel + „“ + Right(SubFoldersNow, Len(SubFoldersNow) - Len(Quelle) - 1)
If PathFileExists(ZielPfad) = 0 Then

MkDir ZielPfad

End If
ScanDir (SubFoldersNow.ParentFolder + „“ + SubFoldersNow.Name)
Next
End Sub

#48

Hallo Joe,

ZielPfad gibt es an der stellen nicht mehr:/
hmm

ich habe schon fast alles Positionen ausprobiert aber leider
ohne
erfolg.
wo könnte das mit dem funktionieren.

If n = 0 Then
RmDir ZielPfad
End If

Sub ScanDir(ScanPfad)
Dim PathObject, FileObject, FileNow, SubFolders,
SubFoldersNow, f1, dt1, f2, dt2, dt3, dd
Dim ZielPfad As String
Dim ZielDatei
Dim n As Long

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

n = 0

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) -
Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then

Set f1 = MyFSO.GetFile(FileNow)
dt3 = f1.DateCreated
If DateM = 0 Then
If DateDiff(„m“, dt3, Date) dt2 Then
If DateDiff(„s“, dt2, dt1) > 0
Then
On Error Resume Next
FileCopy FileNow, ZielDatei
n = n + 1

End If
End If
Else
Form1.Refresh
DoEvents
End If
End If
Next

'An dieser Stelle muß in PathObject noch der Quellpfad stehen. Aus dem mußt Du wohl den Zielpfad ‚stricken‘, so wie unten. Wenn Du damit ein Objekt für FSO baust, bekommst Du mit der Eigenschaft ‚.Count‘ die Anzahl Files im Verzeichnis. Ist die *0* kannst Du das Verzeichnis löschen.

Aus dem Kopf, ohne das vollständige Projekt, bekomme ich hier keinen lauffähigen Code zustande, dafür habe ich mit FSO zu wenig Übung.

Set SubFolders = PathObject.SubFolders
For Each SubFoldersNow In SubFolders
ZielPfad = Ziel + „“ + Right(SubFoldersNow,
Len(SubFoldersNow) - Len(Quelle) - 1)
If PathFileExists(ZielPfad) = 0 Then

MkDir ZielPfad

End If
ScanDir (SubFoldersNow.ParentFolder + „“ +
SubFoldersNow.Name)
Next
End Sub

Gruß, Rainer

#49

moin Rainer,

Mit Text1.Text = PathObject konnte ich festellen das hier der ZielORdner drinsteht also habe ich einfach RmDir PathObject an die stelle geschrieben … und nun kommt das Problem :stuck_out_tongue:

Unterordner … Es wird ein Ordner angelegt in dem nur andere Ordner erstellt werden in diese danach Files reingeschrieben werden …

Ordner wird erstellt , die Schleife wird neu gestartet und unten kurz bevor der Unterordner erstellt wird, wird der Ordner gelöscht weil n=1 …

Ich würde gern nach dem Kopiervorgang einen Scan machen auf Ordner Ohne Inhalt :frowning: wie müsste das aussehen? oder gibt es noch einen anderen weg ?

mfg JOE ( Danke )

#50

Hallo Joe,

Mit Text1.Text = PathObject konnte ich festellen das hier der
ZielORdner drinsteht also habe ich einfach RmDir PathObject an
die stelle geschrieben … und nun kommt das Problem :stuck_out_tongue:

Unterordner … Es wird ein Ordner angelegt in dem nur andere
Ordner erstellt werden in diese danach Files reingeschrieben
werden …

Stimmt, wenn der Ordner gelöscht wird, wenn er leer ist, kann das Programm die nötigen Unterordner nicht anlegen. Das geht so also nicht, da habe ich mich geirrt.

Ordner wird erstellt , die Schleife wird neu gestartet und
unten kurz bevor der Unterordner erstellt wird, wird der
Ordner gelöscht weil n=1 …

Ich würde gern nach dem Kopiervorgang einen Scan machen auf
Ordner Ohne Inhalt :frowning: wie müsste das aussehen? oder gibt es
noch einen anderen weg ?

Ganz offensichtlich nein. Du mußt wirklich den Code, der die Quelle durchsucht noch einmal auf das Ziel anwenden, nichts kopieren und das Verzeichnis nur löschen, wenn es weder Dateien noch Unterverzeichnisse enthält. Bevor der Kopiervorgang abgeschlossen ist, steht das ja noch nicht fest.

Gruß, Rainer

#51

Oh man, die n+1 variante hat mir besser gefallen :confused:

Also mache ich eine neue SUB ohne kopiervorgang die gestartet wird wenn der erste vergleich / kopiervorgang durch ist ?
aber wie stelle ich fest das der ORdner leer ist ?
nun habe ich echt ein problem …

im mom sieht es so aus.

Sub ScanDir(ScanPfad)

Set PathObject = MyFSO.GetFolder(ScanPfad)
Set FileObject = PathObject.Files

For Each FileNow In FileObject
ZielDatei = Ziel + „“ + Right(FileNow, Len(FileNow) - Len(Quelle) - 1)
If PathFileExists(ZielDatei) = 0 Then

Set f1 = MyFSO.GetFile(FileNow)
dt3 = f1.DateCreated
If DateM = 0 Then
If DateDiff(„m“, dt3, Date) dt2 Then

If DateDiff(„s“, dt2, dt1) > 0 Then

On Error Resume Next
FileCopy FileNow, ZielDatei

End If
End If
Else
Form1.Refresh
DoEvents
End If
End If

Text1.Text = PathObject

Next

Set SubFolders = PathObject.SubFolders
For Each SubFoldersNow In SubFolders

ZielPfad = Ziel + „“ + Right(SubFoldersNow, Len(SubFoldersNow) - Len(Quelle) - 1)
If PathFileExists(ZielPfad) = 0 Then

MkDir ZielPfad

End If
ScanDir (SubFoldersNow.ParentFolder + „“ + SubFoldersNow.Name)
Next
End Sub

#52

Hi Joe,

Oh man, die n+1 variante hat mir besser gefallen :confused:

ja, mir auch, das sah so schön einfach aus. Weil wir da aber noch nicht wissen, ob nicht ein ‚Subfolder‘ eingetragen werden muß, geht das nicht.

Also mache ich eine neue SUB ohne kopiervorgang die gestartet
wird wenn der erste vergleich / kopiervorgang durch ist ?

Ja.

aber wie stelle ich fest das der ORdner leer ist ?
nun habe ich echt ein problem …

Nein, denke ich nicht. Ich habe das mal als eigenes, neues Projekt gemacht, das mußt Du nur bei Dir einbauen.

Wie ich die Anzahl ‚Subfolder‘ bekomme habe ich auch nicht gefunden, also habe ich die ‚zählen‘ müssen.

Dann hat das Programm erst mal immer nur den Ordner der letzten Ebene entfernt, von da wieder den Parent-Folder zu scannen und da dann eventuell wieder den Parent-Folder habe ich auch noch nicht hin bekommen. Das sehe ich mir noch weiter an und hoffe, daß ich das noch vereinfachen, beschleunigen kann. Der Code ist also noch nicht optimal, funktioniert aber schon. :smile: Sieh gelegentlich noch mal nach, da kommt bestimmt noch eine bessere Variante.

Option Explicit
Dim MyFSO
Dim pfd As String
Dim Flag As Boolean

Private Sub Form\_Load()
 Set MyFSO = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Command1\_Click()
 Flag = True
 While Flag = True
 DeleteEmptyFolder ("C:\EDI")
 Wend
 Command1.Caption = "fertg"
End Sub

Sub DeleteEmptyFolder(ScanPfad)
 Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow
 Dim fc As Long, pc As Long
 On Error Resume Next
 Set PathObject = MyFSO.getFolder(ScanPfad)
 Set FileObject = PathObject.Files
 fc = FileObject.Count
 Set SubFolders = PathObject.SubFolders
 pc = 0
 For Each SubFoldersNow In SubFolders
 pc = pc + 1
 Next
 If fc = 0 And pc = 0 Then
 RmDir pfd
 Flag = True
 Exit Sub
 Else
 Flag = False
 For Each SubFoldersNow In SubFolders
 pfd = (SubFoldersNow.parentfolder + "\" + SubFoldersNow.Name)
 DeleteEmptyFolder (SubFoldersNow.parentfolder + "\" + SubFoldersNow.Name)
 Next
 End If
End Sub

Gruß, Rainer

#53

Moin Rainer,

was soll ich sagen … DANKE!!!

ich muss die Prozedur auf den Ordner 1-2 mal anwenden um auch leere ordner in Unterordner zu löschen… aber das ist das kleinste problem.

Ich melde mich evtl. heute abend wieder:stuck_out_tongue:

DANKE !! mfg joe

#54

Hallo Joe,

so, ein Problem gelöst, die Zählschleife ist weg.

ich muss die Prozedur auf den Ordner 1-2 mal anwenden um auch
leere ordner in Unterordner zu löschen… aber das ist das
kleinste problem.

Sieh Dir mal ‚Command1_Click‘ an. Daß die Prozedur so ift aufgerufen wird, bis alle Unterordner weg sind, erledigt das Flag.

Nach oben hangeln habe ich zwar hin bekommen, aber wenn ein Unterordner gelöscht wurde kann ich anschließend den Ordner, der diesen Unterordner enthalten hat nicht löschen, da bekomme ich einen Zugriffsfehler. Warum es nach ‚Exit Sub‘ dann doch geht, weiß ich noch nicht. Hier erst mal der Code mit der ersten, kleinen Verbesserung:

Option Explicit
Dim MyFSO
Dim pfd As String, pfd2 As String
Dim Flag As Boolean

Private Sub Form\_Load()
 Set MyFSO = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Command1\_Click()
 Flag = True
 While Flag = True
 DeleteEmptyFolder ("C:\EDI")
 Wend
 Command1.Caption = "fertg"
End Sub

Sub DeleteEmptyFolder(ScanPfad)
 Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow
 Dim fc As Long, pc As Long, en As String
 Set PathObject = MyFSO.getFolder(ScanPfad)
 Set FileObject = PathObject.Files
 fc = FileObject.Count
 Set SubFolders = PathObject.SubFolders
 pc = SubFolders.Count
 pfd = PathObject.Path
 If fc = 0 And pc = 0 Then
 RmDir pfd
 Flag = True
 Exit Sub
 Else
 Flag = False
 For Each SubFoldersNow In SubFolders
 DeleteEmptyFolder (SubFoldersNow.ParentFolder + "\" + SubFoldersNow.Name)
 Next
 End If
End Sub

Gruß, Rainer

#55

Hallo Joe,

ich muss die Prozedur auf den Ordner 1-2 mal anwenden um auch
leere ordner in Unterordner zu löschen… aber das ist das
kleinste problem.

Neuer Code, jetzt geht’s richtig, ohne mehrfach aufrufen.

Option Explicit
Dim MyFSO

Private Sub Form\_Load()
 Set MyFSO = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Command1\_Click()
 DeleteEmptyFolder ("C:\EDI")
 Command1.Caption = "fertig"
End Sub

Sub DeleteEmptyFolder(ScanPfad)
 Dim PathObject, FileObject, FileNow, SubFolders, SubFoldersNow, SubSubFolders
 Dim fc As Long, pc As Long, en As String
 Set PathObject = MyFSO.getFolder(ScanPfad)
 Set SubFolders = PathObject.SubFolders
 For Each SubFoldersNow In SubFolders
 Set FileObject = SubFoldersNow.Files
 Set SubSubFolders = SubFoldersNow.SubFolders
 fc = FileObject.Count
 pc = SubSubFolders.Count
 If fc = 0 And pc = 0 Then
 SubFoldersNow.Delete
 Else
 DeleteEmptyFolder (SubFoldersNow.ParentFolder + "\" + SubFoldersNow.Name)
 End If
 Next
 Set SubFolders = PathObject.SubFolders
 For Each SubFoldersNow In SubFolders
 Set FileObject = SubFoldersNow.Files
 Set SubSubFolders = SubFoldersNow.SubFolders
 fc = FileObject.Count
 pc = SubSubFolders.Count
 If fc = 0 And pc = 0 Then
 SubFoldersNow.Delete
 End If
 Next
End Sub

Da hatte ich einen Knoten im Hirn, den zu entwirren war nicht leicht. :smile:

Jetzt klappt’s aber ohne unnötige Schleifen.

Gruß, Rainer

#56

Hallo Rainer,

ich hatte mich schon gefreut und dacht nun ist mein Programm fertig…
aber dazu wird es wohl nie kommen :stuck_out_tongue:

kurz frage:
ich möchte die 6 durch eine Variable (Integer) ersätzen. Wenn ich sie einfach einsätze oder in Klammern schreibe geht das nicht ?
wie muss das ausehen?

If DateDiff(„m“, dt3, Date)

#57

Hallo Joe,

ich hatte mich schon gefreut und dacht nun ist mein Programm
fertig…
aber dazu wird es wohl nie kommen :stuck_out_tongue:

kurz frage:
ich möchte die 6 durch eine Variable (Integer) ersätzen. Wenn
ich sie einfach einsätze oder in Klammern schreibe geht das
nicht ?
wie muss das ausehen?

If DateDiff(„m“, dt3, Date)

Gibt einen Wert vom Typ Variant (Long) zurück, der die Anzahl der Zeitintervalle zwischen zwei bestimmten Terminen angibt.

Deine Variable muß von Typ Long sein, mit Integer geht’s nicht.

Gruß, Rainer

#58

Nabend Rainer,

Ich schreibe die werte eines LAbels oder einer Klickbox „direkt“ in die Datei ohne eine Variable anzugeben z.b.

Print #ff, Label6.Caption
Print #ff, Check5.Value
Print #ff, Check6.Value

Das auslesen mache ich anhand einer Variable da ich es nicht anders hinbekomme …

Line Input #ff, Quell6
Line Input #ff, on5
Line Input #ff, on6

Kann ich diese werte nicht auch direkt in das „Objekt“ schreiben ?
Line Input #ff, Check6.Value geht leider nicht auch nichtmit ().

Problem ist das ich mit meiner 6ten Variable ein Problem habe … und keinPlan warum …

Public on1, on2, on3, on4, on5, on6 As Integer

Line Input #ff, on1
Line Input #ff, on2
Line Input #ff, on3
Line Input #ff, on4
Line Input #ff, on5
Line Input #ff, on6

Check1.Value = on1
Check2.Value = on2
Check3.Value = on3
Check4.Value = on4
Check5.Value = on5
Check6.Value = on6

und später
Print #ff, Check1.Value
Print #ff, Check2.Value
Print #ff, Check3.Value
Print #ff, Check4.Value
Print #ff, Check5.Value
Print #ff, Check6.Value

doch meldet VB bei der:
Line Input #ff, on6
type mismatch, aber nur bei der „on6“ der letzte eintrag im File… ich habe die Variablen schon umbenannt aber ohne erfolg…

Thx mfg joe

#59

Moin Joe,

Ich schreibe die werte eines LAbels oder einer Klickbox
„direkt“ in die Datei ohne eine Variable anzugeben z.b.

Print #ff, Label6.Caption
Print #ff, Check5.Value
Print #ff, Check6.Value

Das auslesen mache ich anhand einer Variable da ich es nicht
anders hinbekomme …

Line Input #ff, Quell6
Line Input #ff, on5
Line Input #ff, on6

Kann ich diese werte nicht auch direkt in das „Objekt“
schreiben ?
Line Input #ff, Check6.Value geht leider nicht auch nichtmit
().

ja, hat mich auch schon geärgert, daß man die Werte erst in Variablen schreiben muß. Nein, geht afaik nicht anders.

Problem ist das ich mit meiner 6ten Variable ein Problem habe
… und keinPlan warum …

Public on1, on2, on3, on4, on5, on6 As Integer

da sehe ich eine Falle. Du dimensionierst on1, on2 … als Variant, on6 dimensionierst Du als Integer. Scheinbar ist integer der falsceh Typ, wenn Du Ärger mit on6 hast.

Vermutlich wolltest Du alle als Integer dimensionieren, das geht so nicht, dann müßtest du schreiben:

Dim on1 as integer, on2 as integer, on3 as integer… kürzer geht’s nicht.

Line Input #ff, on1
Line Input #ff, on2
Line Input #ff, on3
Line Input #ff, on4
Line Input #ff, on5
Line Input #ff, on6

Check1.Value = on1
Check2.Value = on2
Check3.Value = on3
Check4.Value = on4
Check5.Value = on5
Check6.Value = on6

und später
Print #ff, Check1.Value
Print #ff, Check2.Value
Print #ff, Check3.Value
Print #ff, Check4.Value
Print #ff, Check5.Value
Print #ff, Check6.Value

doch meldet VB bei der:
Line Input #ff, on6
type mismatch,

Du bekommst mit Lineinput einen String, den kannst Du nicht in eine Integer Variable schreiben.

aber nur bei der „on6“

weil on6 as einziges vom Typ Integer ist.

Warum machst Du das nicht mit einer Schleife und einem Steuerelemetefeld, dann baruchst Du nicht so viele variablen.

Wie gefällt Dir das:

Option Explicit

Dim na As String

Private Sub Command1\_Click()
 Dim ff As Integer
 ff = FreeFile
 Open na For Output As #ff
 For i = LBound(Check1) To UBound(Check1)
 Print #ff, Check1(i).Value
 Next
 Close #ff
End Sub

Private Sub Command2\_Click()
 Dim ff As Integer
 ff = FreeFile
 Dim wert As String, n As Integer
 Open na For Input As #ff
 While Not EOF(ff)
 Line Input #ff, wert
 Check1(n).Value = Val(wert)
 n = n + 1
 Wend
 Close #ff
End Sub

Gruß, Rainer

#60

Hallo Joe,

eine Frage noch, warum eigentlich LineInput? Du schreibst nur eine Zahl und willst nur eine Zahl lesen. Wenn Du nur …

Input #1, wert

schreibst, darf Wert auch Integer sein und Du spartst Dir die Konvertierung.

Gruß, Rainer