Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Überprüfung der gefundenen Dateien

Betrifft: Überprüfung der gefundenen Dateien von: Thorsten
Geschrieben am: 27.08.2014 15:41:08

Wertes Forum,

folgendes Makro benutze ich um Dateien in meiner Range zu suchen und in einen Ordner zu kopieren:

Sub Kopieren2()
Dim rngRange As Range
Dim sDir$
Dim lngCreatePath&
Dim Pfad As String
Dim zPfad As String
Dim Dateiname As String

'Bereich
Set rngRange = Tabelle1.Range("B9:I16")

'Pfad Quelle
'Const sPathQuelle$ = "XXX"
Pfad = ThisWorkbook.Sheets("Tabelle1").Range("B26")

'Pfad Ziel
'Const sPathZiel$ = "XXX"
zPfad = ThisWorkbook.Sheets("Tabelle1").Range("B30")

'Ordner anlegen wenn nicht vorhanden
lngCreatePath = apiCreateFullPath(Left$(zPfad, InStrRev(zPfad, "\")))

If lngCreatePath = 1 Then
    For Each rngRange In rngRange.Cells
        If rngRange.Value <> "" Then
            sDir = Dir$(Pfad & rngRange.Value & "*.txt", vbNormal)
            If sDir <> "" Then
                FileCopy Pfad & sDir, zPfad & sDir
            End If
        End If
    Next rngRange
    MsgBox "Fertig"
Else
    MsgBox "Ordner konnte nicht angelegt werden!", vbCritical
End If
End Sub
Meine Frage ist nun wie ich einen Zähler einbauen kann in mein Makro der mir bei der Msg Box nicht nur sagt "Fertig" sondern nehmen wir mal an er kopiert 4 Dateien das er sagt 4/4 Dateien gefunden und kopiert und eben dann 2/4 Dateien gefunden wenn es weniger waren.

Das wäre super! Vielen Dank!

  

Betrifft: AW: Überprüfung der gefundenen Dateien von: Klaus M.vdT.
Geschrieben am: 27.08.2014 15:54:56

Hi Thorsten,
ungetestet, da ich keine Musterdatei habe und auch die Pfadstruktur nicht nachbaue:

Sub Kopieren2()
Dim rngRange As Range
Dim sDir$
Dim lngCreatePath&
Dim Pfad As String
Dim zPfad As String
Dim Dateiname As String

Dim AnzahlGefunden As Long
Dim AnzahlKopiert As Long
AnzahlGefunden = 0
AnzahlKopiert = 0

'Bereich
Set rngRange = Tabelle1.Range("B9:I16")

'Pfad Quelle
'Const sPathQuelle$ = "XXX"
Pfad = ThisWorkbook.Sheets("Tabelle1").Range("B26")

'Pfad Ziel
'Const sPathZiel$ = "XXX"
zPfad = ThisWorkbook.Sheets("Tabelle1").Range("B30")

'Ordner anlegen wenn nicht vorhanden
lngCreatePath = apiCreateFullPath(Left$(zPfad, InStrRev(zPfad, "\")))

If lngCreatePath = 1 Then
    For Each rngRange In rngRange.Cells
        If rngRange.Value <> "" Then
            AnzahlGefunden = AnzahlGefunden + 1
            sDir = Dir$(Pfad & rngRange.Value & "*.txt", vbNormal)
            If sDir <> "" Then
                AnzahlKopiert = AnzahlKopiert + 1
                FileCopy Pfad & sDir, zPfad & sDir
            End If
        End If
    Next rngRange
    MsgBox "Fertig, " & AnzahlGefunden & " mal gefunden, und " & AnzahlKopiert & "mal  _
kopiert."
Else
    MsgBox "Ordner konnte nicht angelegt werden!", vbCritical
End If
End Sub
Grüße,
Klaus M.vdT.


  

Betrifft: AW: Überprüfung der gefundenen Dateien von: Thorsten
Geschrieben am: 27.08.2014 16:02:09

VIELEN DANK! SUPER!!!


  

Betrifft: Danke für die Rückmeldung! owT. von: Klaus M.vdT.
Geschrieben am: 28.08.2014 07:52:12

.


 

Beiträge aus den Excel-Beispielen zum Thema "Überprüfung der gefundenen Dateien"