Hallo,
ich habe ein Makro geschrieben, welches in der Spalte A nacheinander eine Nummer speichert und diese
Nummer zusammen mit einem gespeichertem Pfad und der Endung „.pdf“ als
absoluten Pfad speichert. Nach diesem Prozess wird die Datei aus dem
Quellordner in einen Zielordner gespeichert.
Mein Problem:
Manchmal gibt es mehrere Dateien - alles vom selbem Typ - mit derselben Nummer (z. B. 00343 und
00343_2012 oder 00343_2012_2). Bei so einem Fall sollten alle diese Dateien in
den Zielordner gespeichert werden. Wie müsste ich es programmieren, dass der
Dateiname eben nur „Like“ 00343 ist?
Hier mein bisheriger Code (Paar Sachen sind nur zum
Test da):
Spoiler anzeigen
Wäre voll cool wenn es klappt, danke :D
ich habe ein Makro geschrieben, welches in der Spalte A nacheinander eine Nummer speichert und diese
Nummer zusammen mit einem gespeichertem Pfad und der Endung „.pdf“ als
absoluten Pfad speichert. Nach diesem Prozess wird die Datei aus dem
Quellordner in einen Zielordner gespeichert.
Mein Problem:
Manchmal gibt es mehrere Dateien - alles vom selbem Typ - mit derselben Nummer (z. B. 00343 und
00343_2012 oder 00343_2012_2). Bei so einem Fall sollten alle diese Dateien in
den Zielordner gespeichert werden. Wie müsste ich es programmieren, dass der
Dateiname eben nur „Like“ 00343 ist?
Hier mein bisheriger Code (Paar Sachen sind nur zum
Test da):
Visual Basic-Quellcode
- Sub test()
- Dim oldFolder As String
- Dim newFolder As String
- Dim file As String
- Dim iRow As String
- iRow = 1
- Dim laufwerk As String
- Dim artNr As String
- Dim laenge As Integer
- On Error GoTo ErrHandler
- ' Warnhinweis
- If MsgBox("Bitte stellen Sie folgendes sicher:" & Chr(13) & "" & Chr(13) & "1. Alle Artikelnummern stehen in Spalte A" & Chr(13) & "2. Es befinden sich keine Leerzeilen in Spalte A", vbOKCancel + vbExclamation, "Achtung!") = vbOK Then
- 1:
- ' Auswahl des Quellordners
- MsgBox ("Bitte Quellordner auswählen.")
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show = True Then
- MyFolder = .SelectedItems(1)
- Else
- Exit Sub
- End If
- End With
- oldFolder = MyFolder & "\"
- ' Bestätigung des Quellordners
- If MsgBox("Quellordner:" & Chr(13) & oldFolder, vbOKCancel, "Quellordner") = vbCancel Then
- GoTo 1
- End If
- 2:
- ' Auswahl des Zielordners
- MsgBox ("Bitte Zielordner auswählen.")
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show = True Then
- MyFolder = .SelectedItems(1)
- Else
- Exit Sub
- End If
- End With
- newFolder = MyFolder & "\"
- ' Bestätigung des Zielordners
- If MsgBox("Zielordner:" & Chr(13) & newFolder, vbOKCancel, "Zielordner") = vbCancel Then
- GoTo 2
- End If
- '' Bearbeitung vom Problem
- ' Alle Zellen mit Inhalt werden markiert
- Selection.SpecialCells(xlCellTypeConstants).Select
- ' Markierte Zellen werden als Text formatiert
- Selection.NumberFormat = "@"
- Do
- ' Zelle A1 wird Ausgewählt
- Cells(iRow, 1).Select
- ' Aktive Artnr. speichern
- artNr = ActiveCell.Value
- ' Überprüfung der Länge der ausgewählten Artnr.
- laenge = Len(artNr)
- ' Überprüfung ob Ausgewählte Artnr. zu kurz ist, weil Nullen fehlen
- Select Case laenge
- Case Is = 1
- ActiveCell.Value = "0000" & artNr
- Case Is = 2
- ActiveCell.Value = "000" & artNr
- Case Is = 3
- ActiveCell.Value = "00" & artNr
- Case Is = 4
- ActiveCell.Value = "0" & artNr
- End Select
- ' Genauer Dateipfad wird erzeugt
- file = ActiveCell.Value & ".pdf"
- ' Datei wird von Quellordner in Zielordner kopiert
- FileCopy oldFolder & file, newFolder & file
- ' Zelle wird grün gefärbt
- ActiveCell.Interior.Color = vbGreen
- weiter:
- iRow = iRow + 1
- Loop Until IsEmpty(Cells(iRow, 1))
- Exit Sub
- ErrHandler:
- ' Zelle wird rot gefärbt, wenn Datei nicht vorhanden
- ActiveCell.Interior.Color = vbRed
- Resume weiter
- Exit Sub
- Else
- Exit Sub
- End If
- End Sub
Wäre voll cool wenn es klappt, danke :D