Ordner kopieren & UserForm aktualisieren
18.12.2020 12:21:00
Flo
ich hab da folgendes Problem:
In einer Excel Datei habe ich 3 Arbeitsblätter (Start, [Quelle] & [Ziel] ), wobei Quelle und Ziel immer unterschiedlich benannt sein können.
Durch ein Makro wurden im Sheet [Quelle] in der Spalte "M" teilweise Ordnerpfade eingetragen.
(Bsp.: M54:"\\NAS1\ARCHIV\Ordner1\" M78:"\\NAS1\ARCHIV\Ordner2\" M471:"\\NAS1\ARCHIV\Ordner3\" ) usw.
Durch ein weiteres Makro werden die Pfadangaben eingelesen und Ordner für Ordner von einem Verzeichnis(Quelle) in ein anderes(Ziel) kopiert. Es sind je nach dem ganz unterschiedlich viele.
Manchmal sind es nur 10, ein anderes mal 200 Ordner.
Der Kopiervorgang läuft auch immer ohne Problme.
Beim starten des Makro habe ich jetzt noch zusätzlich eine Userform eingebastellt.
In der Userform ist eine Textbox die den aktuell zu kopierenden Pfad anzeigen soll. Allerdings zeigt die Textbox mir immer nur den ersten Ordner von den ganzen Kopiervorgang an. Die Anzeige läuft einfach nicht weiter obwohl die weiteren Ordner fleißig weiter kopiert werden. Wie kann ich das realisieren?
Kurze Rede, Langer Sinn
hier der Code:
Option Explicit
Private objSheetQV As Object
Private objSheetZV As Object
Private letZeiQV As Long
Private zNr As Long
Dim wksQV As String
Dim wksZV As String
Dim QuellPfad As String
Dim ZielPfad As String
Sub FolderCopyStart()
wksQV = Worksheets("Start").[Quelle]
wksZV = Worksheets("Start").[Ziel]
Set objSheetQV = Worksheets(wksQV)
Set objSheetZV = Worksheets(wksZV)
letZeiQV = objSheetQV.Cells(Rows.Count, 2).End(xlUp).Row
Load frm_Copy
With Application.WorksheetFunction
For zNr = 2 To letZei_QV Step 1
QuellPfad = objSheetQV.Range("M" & zNr)
ZielPfad = objSheetZV.Range("A1")
If QuellPfad "" Then
Load frm_Copy
frm_Copy.UserForm_Initialize
frm_Copy.QuellPfad_Tb.Value = QuellPfad
frm_Copy.Show
CreateObject("Scripting.FileSystemObject").CopyFolder QuellPfad, ZielPfad
End If
Next zNr
End With
End Sub
Ich Danke euch jetzt schon mal im vorraus
Gruß Flo