Ordner anlegen und Dateien kopieren

Moin wieder zusammen,
Hatte hier schon zweimal mein Problem angegeben, aber leider keine Hilfe bekommen es war aber vielleicht nicht verständlich rübergekommen Probiere es hiermit noch einmal.
So sollte der Pfad aussehen:
C:\Temp\1
C:\Temp\2
.....
Ich wollte in den 1.Unterordner eine Datei von C:\Temp\ kopieren wenn die Datei in dem 1. Ordner schon vorhanden ist müßte ein 2 Unterordner erstellt werden und das immer so weiter. Die Unterordner sollen aber erst erstellt werden wenn mann die Datei kopieren müßte. Dadurch kennt mann vorher noch nicht die fortlaufende Nummer denn ich wollte keine 50 ordner(als Beispiel) schon von Anfang an haben.
Ich würde denken das das alles über eine Schleife laufen muß aber da ich erst mit VBA angefangen habe bekomme ich das leider nicht hin wäre sehr dankbar über Eure Hilfe.
mfg rene

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rene!
Schreib diesen Code in ein allgemeines Modul.
Option Explicit
Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Public Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" ( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Public Function FileExist(ByVal Dateiname As String) As Boolean
On Error GoTo errorhandler
If Dateiname = "" Then GoTo errorhandler
FileExist = Dir$(Dateiname) <> ""
Exit Function
errorhandler:
FileExist = False
Resume Next
End Function

Private Sub Pfad_anlegen(strPath As String)
MakeSureDirectoryPathExists strPath
End Sub

Sub anlegen()
Dim i As Integer
Dim myPath As String
Dim myFile As String
myPath = "C:\Temp\"
myFile = "test.xls"
For i = 1 To 50
If FileExist(myPath & i & "\" & myFile) = False Then
Pfad_anlegen myPath & i & "\"
CopyFile myPath & myFile, myPath & i & "\" & myFile, 0
Exit Sub
End If
Next
End Sub
Gruß Sepp

Private Sub CommandButton1_Click() Dim i As Integer Dim myPath As String Dim myFile As String myPath = "C:\Temp\" myFile = "test.xls" For i = 1 To 50 If FileExist(myPath & i & "\" & myFile) = False Then Pfad_anlegen myPath & i & "\" CopyFile myPath & myFile, myPath & i & "\" & myFile, 0 Exit Sub End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Ordner anlegen und Dateien kopieren

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordner anlegen und Dateien kopieren

14 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)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread