Zellen auslesen, in Ordnern suchen und kopieren
Betrifft: Zellen auslesen, in Ordnern suchen und kopieren
von: Thomas
Geschrieben am: 01.08.2014 12:53:59
Hallo liebe Community,
folgendes Szenario möchte ich mit Hilfe von VBA Excel verwirklichen:
Ich habe ein Excel File mit einem Formular in das Seriennummern eingetragen werden. Das Formular hat 8 Zeilen und 8 Spalten. In jede Zelle wird eine 4-stellige Seriennummer eingetragen. Die Seriennummer wird manuell eingetragen durch Sichtprüfung. Bisher wurde immer manuell der dazu passende Prüfbericht in den Ordnern gesucht. Ich möchte nun das sobald ich alle SN eingetragen habe, die Excel Programmierung mir in den Ordnern das jeweilige txt. Dokument raussucht für jede einzelne Zelle und in einen seperaten Ordner kopiert. Der Name des Orderns kann der Zelleninhalt einer Zelle zu Beginn sein ("Lieferung 1" etwa).
Wäre super wenn mir jemand helfen könnte!
Besten Dank!
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Tino
Geschrieben am: 01.08.2014 14:32:26
Hallo,
mal eine Version.
Sub Kopieren_()
Dim rngRange As Range
Dim sDir$
'Bereich
Set rngRange = Tabelle2.Range("A2:H9")
'Pfad Quelle
Const sPathQuelle$ = "G:\1 Forum\"
'Pfad Ziel
Const sPathZiel$ = "G:\1 Forum\Neuer Ordner (4)\"
For Each rngRange In rngRange.Cells
If rngRange.Value <> "" Then
sDir = Dir$(sPathQuelle & rngRange.Value & "*.txt", vbNormal)
If sDir <> "" Then
FileCopy sPathQuelle & sDir, sPathZiel & sDir
End If
End If
Next rngRange
MsgBox "Fertig"
End Sub
Gruß Tino
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Thomas
Geschrieben am: 01.08.2014 14:52:11
Vielen Dank! Also funktionieren tut es! Jedoch muss ich den Ordner in der er die Dateien speichert seblst anlegen. Geht das auch automatisiert das ich oben ein Feld habe und der Zelleninhalt wird mein Ordner.
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Tino
Geschrieben am: 02.08.2014 09:51:35
Hallo,
müsste so funktionieren!
Private Declare Function apiCreateFullPath _
Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Sub Kopieren_()
Dim rngRange As Range
Dim sDir$
Dim lngCreatePath&
'Bereich
Set rngRange = Tabelle2.Range("A2:H9")
'Pfad Quelle
Const sPathQuelle$ = "G:\1 Forum\"
'Pfad Ziel
Const sPathZiel$ = "G:\1 Forum\Neuer Ordner (5)\"
'Ordner anlegen wenn nicht vorhanden
lngCreatePath = apiCreateFullPath(Left$(sPathZiel, InStrRev(sPathZiel, "\")))
If lngCreatePath = 1 Then
For Each rngRange In rngRange.Cells
If rngRange.Value <> "" Then
sDir = Dir$(sPathQuelle & rngRange.Value & "*.txt", vbNormal)
If sDir <> "" Then
FileCopy sPathQuelle & sDir, sPathZiel & sDir
End If
End If
Next rngRange
MsgBox "Fertig"
Else
MsgBox "Ordner konnte nicht angelegt werden!", vbCritical
End If
End Sub
Gruß Tino
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Thomas
Geschrieben am: 07.08.2014 09:06:03
Hallo Tino!
Vielen Dank erstmal für deine Hilfe.
Funktioniert einwandfrei jedoch hätt ich noch ein paar Dinge:
Ist es möglich den Pfad (Quelle und Ziel) manuell auswählen zu lassen, damit der Nutzer den Quellordner auswählen kann und sagen kann unter welchem Ordnernamen er wo speichern soll.
Vielen Dank
  |
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Thomas
Geschrieben am: 07.08.2014 11:02:32
Hallo!
Mir ist eine neue Idee gekommen:
Für die Quelldatei wäre es sinnvoll das der Benutzer nicht den Ordner selbst suchen müsste in dem er die .txt Dateien finden kann sondern wenn das Makro es automatisch machen könnte. In der Excel Tabelle gibt es zwei Nummer: "123456" und "A12". Diese Nummern setzen sich zusammen zum Ordner "123456_A12". Jetzt wäre es klasse wenn das Makro den Quellpfad bekommt und in der Liste der vielen Ordner anhand der zwei Nummern den richtigne findet.
Dannach soll wie gehabt nach der Eingabe der Seriennnummern er die Zellen abgleichen und in dem Ordner nach der .txt Datei suchen, kopieren in einen Ordner mit dem Namen der in einer Zelle zu Beginn steht und diesen speichern und am Ende eine Msg Box aufpoppen.
Die Msg Box soll foglenden Inhalt haben: 15 von 15 kopiert oder noch besser wenn er sagen könnte welche Dateien nicht gefunden wurden, wenn es dazu kommt.
Vielen vielen Dank
| |
Betrifft: AW: Zellen auslesen, in Ordnern suchen und kopieren
von: Thomas
Geschrieben am: 07.08.2014 11:02:49
Hallo!
Mir ist eine neue Idee gekommen:
Für die Quelldatei wäre es sinnvoll das der Benutzer nicht den Ordner selbst suchen müsste in dem er die .txt Dateien finden kann sondern wenn das Makro es automatisch machen könnte. In der Excel Tabelle gibt es zwei Nummer: "123456" und "A12". Diese Nummern setzen sich zusammen zum Ordner "123456_A12". Jetzt wäre es klasse wenn das Makro den Quellpfad bekommt und in der Liste der vielen Ordner anhand der zwei Nummern den richtigne findet.
Dannach soll wie gehabt nach der Eingabe der Seriennnummern er die Zellen abgleichen und in dem Ordner nach der .txt Datei suchen, kopieren in einen Ordner mit dem Namen der in einer Zelle zu Beginn steht und diesen speichern und am Ende eine Msg Box aufpoppen.
Die Msg Box soll foglenden Inhalt haben: 15 von 15 kopiert oder noch besser wenn er sagen könnte welche Dateien nicht gefunden wurden, wenn es dazu kommt.
Vielen vielen Dank
| |
Beiträge aus den Excel-Beispielen zum Thema "Zellen auslesen, in Ordnern suchen und kopieren"
Screenshot zu MsgBox