fso.FileCopy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: fso.FileCopy

20.05.2021 10:44:43

max.kaffl@gmx.de

AW: fso.FileCopy

20.05.2021 13:05:29

ElchBerlin

AW: fso.FileCopy

20.05.2021 13:54:31

Nepumuk

AW: fso.FileCopy

20.05.2021 16:24:15

ElchBerlin

AW: ist Powershell evtl. schneller?

20.05.2021 13:45:08

Jowe

Hallo Nepomuk,
danke für das Mitdenken. Hier der Code (Ausschnitt):
Private Sub CopyPics_Click()
Dim FS As Object
Dim f, fl, fc, i, lp, FileNames, Filename
Dim strPath As String, strPathBase As String, strPicFolder As String, PicFolderLast As String, strTargetBase As String
Dim strFolderDate As String
Dim lngZeile As Long, Ergebnis As Long, Counter As Long, SummenCounter As Long
Dim ZielVerzeichnis As String, SensorIP As String
; hier sind noch etliche Ausgaben und Tests zu finden, die für die große Schleife über fast 170 externe PC notwendig sind
Set FS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
; es handelt sich beim strPicFolder und Verzeichnisse auf externen Rechner, die nur über das Intranet zu erreichen sind
FS.CopyFile strPicFolder & "*_0.tif", strTargetBase & "Zwischenspeicher"
Ergebnis = Err.Number
If Ergebnis 0 Then
If Ergebnis = 76 Then
Cells(lp, 6).Value = "kein Zugriff (" & Trim(Str(Ergebnis)) & ")"
Else
Cells(lp, 6).Value = "Fehler (" & Trim(Str(Ergebnis)) & ")"
End If
End If
Im ungestörten Betrieb läuft das auch prima, nur wenn die Funkstrecke mitten beim Kopieren schlapp macht, hängt der Copy-Prozess sehr lange
Der ErrorHandler greift natürlich erst am Ende (nach eiern halben Stunde warten im Fehlerfall :-( )

Hallo Nepomuk,
an einer anderen Stelle "scanne" ich Verzeichnisse und wenn der Verzeichnisname passt, gehe ich aus der Schleife raus:
Set f = FS.GetFolder(strPath) ' Zugriff auf Datumsverzeichnis im pics-Verzeichnis prüfen
Ergebnis = Err.Number
If Ergebnis <> 0 Then
If Ergebnis = 76 Then
Cells(lp, 5).Value = "keine Daten (" & Trim(Str(Ergebnis)) & ")"
Else
Cells(lp, 5).Value = "Fehler 2 (" & Trim(Str(Ergebnis)) & ")"
End If
Else
lngSubFolderCount = f.SubFolders.Count
lngSFC = 0
Set fc = f.SubFolders
PicFolderLast = ""
For Each fl In fc
lngSFC = lngSFC + 1
DirFile.Text = "Dir " & CStr(lngSFC) & " / " & CStr(lngSubFolderCount)
picFolder = fl.Name
If Dir(strPath & picFolder & "\*Panorama.tif") <> "" Then ' Prüfen, ob Umlauf vollständig war
CopyPics.Enabled = True
PicFolderLast = picFolder
If Val(Mid(PicFolderLast, 3, 2)) > 12 Then Exit For
If Left(PicFolderLast, 4) = "U_12" Then Exit For
End If
Next
Cells(lp, 5).Value = PicFolderLast
End If
Meine Hoffnung war, dass es auch für Files so eine Möglichkeit gibt, ein File stückweise zu kopieren und im Fehlerfall die ganze Schleife abzubrechen:
Set fc = f.Fileverzeichnis
For Each fl In fc
fl.CopyFile strPicFolder & fl, strTargetBase & "Zwischenspeicher"
Ergebnis = Err.Number
If Ergebnis <> 0 Then
Cells(lp, 6).Value = "Fehler"
Exit For
End If

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

1 Forumthread zu ähnlichem Thema

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

fso.FileCopy

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

1 Forumthread zu ähnlichem Thema

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread