Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1584to1588
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
Inhaltsverzeichnis

dummy Datei (txt) erstellen und löschen

dummy Datei (txt) erstellen und löschen
20.10.2017 08:24:47
Peter
Guten Tag
Ich habe ein Makro, das mir eine grosse Anzahl Dateien in eine Summary-Datei zusammenfügt.
Ich kann mir in der Statuszeile keine Fortschrittskontrolle anzeigen lassen (funktioniert nach Import der ersten Dateien schon nicht mehr). Deshalb möchte ich mir wie folgt behelfen:
"Verarbeiten der Dateien läuft nach dem Schema:
For i = 1 To lngZ
Next i
Nun möchte ich bei Beginn einer neuen Datei auf dem Server eine leere txt-Datei erstellen und wenn ich bei next ankomme, diese wieder löschen. Als Dateiname könnte "Temp", ergänzt mit der Laufnummer i verwendet werden.
Kann mir jemand sagen, wie der VBA Code ergänzt werden muss?
Danke und Gruss, Peter

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

Betreff
Datum
Anwender
Anzeige
AW: dummy Datei (txt) erstellen und löschen
20.10.2017 08:43:13
Peter(silie)
Hallo,
hier mal ein wenig Code zum rumprobieren:
(bla ist dein Sub mit der schleife,
Create_Textfile ist eine Function mit zwei Optionalen Parametern: P1 = Pfad, P2 = Inhalt,
Delete_File löscht die als Pfad angegebene Datei
Delete_all_Files_where_Name_like löscht alle dateien innerhalb eines Ordners deren name wie xy sind,
Defaultpath_VBAgent erstellt einen Dateinamen, dort musst du evtl. folgendes machen:
Format(Time, "hh-mm-ss") in Format(Time, "hh-mm-ss-ms"), denn wenn er in der schleife das aufruft um einen Namen zu generieren, und sich die Sekunde nicht verändert hat, überschreibt er die Datei)
Sub bla()
Dim tmpName As String
For i = 1 To lngZ
tmpName = "C:\TEMP\tmp_" & i & ".txt"
Create_Textfile tmpName
'hier löschen? Falls ja dann:
Delete_File tmpName
Next i
'oder hier löschen? Falls ja dann:
Delete_all_Files_where_Name_like "tmp_", "C:\TEMP\"
End Sub
Private Function Create_Textfile(Optional ByVal Save_Path As Variant, Optional ByVal Input_ As  _
Variant) As Boolean
If IsMissing(Save_Path) Then Save_Path = Defaultpath_VBAgent & ".txt"
Dim file_ As Long
file_ = FreeFile
Open Save_Path For Output As #file_
If Not IsMissing(Input_) Then
Print #file_, Input_
End If
Close #file_
End Function
Private Function Delete_File(ByVal File_Path As String) As Boolean
On Error Resume Next
Kill File_Path
On Error GoTo 0
End Function
Private Function Delete_all_Files_where_Name_like(ByVal this_ As String, ByVal InFolder As  _
String) As Boolean
Dim fso, ofolder, ofile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ofolder = fso.GetFolder(InFolder)
For Each ofile In ofolder.FileSystemObject
If InStr(1, ofile.Name, this_) > 0 Then
Kill ofile
End If
Next ofile
End Function
Private Function Defaultpath_VBAgent() As String
Defaultpath_VBAgent = Application.DefaultFilePath & "\DirectoryAgent_File_" & _
Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm-ss")
End Function

Anzeige
kleiner Fehler...
20.10.2017 08:45:11
Peter(silie)
bitte folgendes ändern:
    For Each ofile In ofolder.FileSystemObject
If InStr(1, ofile.Name, this_) > 0 Then
Kill ofile
End If
Next ofile
In:
    For Each ofile In ofolder.Files
If InStr(1, ofile.Name, this_) > 0 Then
Kill ofile
End If
Next ofile

AW: dummy Datei (txt) erstellen und löschen
20.10.2017 08:47:53
ChrisL
Hi Peter
Sub t()
Dim i As Long, lngZ As Long
Dim strPfad As String: strPfad = ThisWorkbook.Path & "\"
' lngZ = ...
For i = 1 To lngZ
Open strPfad & i & ".txt" For Output As #1
Close #1
Kill strPfad & i & ".txt"
Next i
End Sub

cu
Chris
Anzeige
AW: dummy Datei (txt) erstellen und löschen
20.10.2017 09:11:57
Peter
Hallo
Vielen Dank euch beiden.
Ich habe den Code von Chris übernommen.
Funktioniert prima.
Gruss, Peter

242 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige