Ordner anlegen, füllen, Dateien speichern, löschen

Hallo zusammen,
hat jmd ein Beispiel für mich, bei dem ich sehen kann wie ich in einem Makro einen Ordner anlege (Name des Ordners am Besten mit einem Kürzel + Datum) und Dateien aus einem anderein Verzeichnis in diesen Ordner kopiere, nachdem eine bestimmte Aktion (siehe unten) mit diesen Dateien gemacht wurde, soll dieser Ordner wieder gelöscht werden.
Kurz gesagt:
1. Ordner anlegen
2. Neu angelegten Ordner füllen mit Dateien eines bestehenden Ordners (immer Word-Dokumente)
3. Diese Word-Dateien (*.doc, *.rtf) müssen neu gespeichert werden (aktuelles Datum erhalten)
4. Ordner inkl. Dateien löschen
In der Zwischenzeit führe ich mit meinem Makro noch andere Dinge durch, also nicht irritiert sein, öber dieses vielleicht etwas wirre anlegen und löschen von Dateien/Ordnern )
Über eine Hilfe von euch würde ich mich sehr freuen!!!
Iris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Iris,
du musst die Dateien nicht öffnen und wieder speichern. Das geht auch so:

Option Explicit
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Public Sub Aenderungdatum_aendern()
    Dim Ft1 As FILETIME, Ft2 As FILETIME, lngHandle As Long, SysTime As SYSTEMTIME
    Dim udtFileTime As FILETIME, udtLocalTime As FILETIME, udtSystemTime As SYSTEMTIME
    udtSystemTime.wYear = Year(Now)
    udtSystemTime.wMonth = Month(Now)
    udtSystemTime.wDay = Day(Now)
    udtSystemTime.wDayOfWeek = Weekday(Now)
    udtSystemTime.wHour = Hour(Now)
    udtSystemTime.wMinute = Minute(Now)
    udtSystemTime.wSecond = Second(Now)
    udtSystemTime.wMilliseconds = 0
    SystemTimeToFileTime udtSystemTime, udtLocalTime
    LocalFileTimeToFileTime udtLocalTime, udtFileTime
    lngHandle = CreateFile("D:\Eigene Dateien\AEG\Test.txt", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    GetFileTime lngHandle, Ft1, Ft1, Ft2
    SetFileTime lngHandle, Ft1, Ft1, udtFileTime
    CloseHandle lngHandle
End Sub

Das ist nur ein Beispiel für eine Datei. Um mehrere zu ändern wäre eine Schleife nötig. Dazu benötige ich aber den Pfad zu den Dateien.
Gruß
Nepumuk

Sub test() Dim i, datmaxzahl, datanzahl, dat$() Dim Pfad As String Dim appWd As Object Dim WdFile As Object Pfad = "C:\DATA\" ' Dein Verzeichnis ChDir Pfad datmaxzahl = 30 '30 Dateien ReDim dat(datmaxzahl) 'Feld für Dateinamen 'Dateien des aktuellen Verzeichnisses einlesen i = 0 dat(i) = Dir("*.doc") While dat(i) <> "" i = i + 1 dat(i) = Dir() Wend datanzahl = i ' Dateiöffnen For i = 0 To datanzahl - 1 Set appWd = CreateObject("Word.Application.8") 'Word als Object starten appWd.Visible = True Set WdFile = appWd.Documents.Open(Pfad & dat(i)) WdFile.Save WdFile.Close appWd.Quit Next i End Sub

Beliebteste Forumthreads (12 Monate)

Ordner anlegen, füllen, Dateien speichern, löschen

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordner anlegen, füllen, Dateien speichern, löschen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread