VBA_PDF_verschieben

[PhilippB]

Hallo liebe Gemeinde.

Ich wollte mal nachfragen ob mir jemand eventuell mit einem vorhanden Code helfen könnte.
Es geht darum das ich in Spalte A einer Excel Mappe Nummern habe welche irgendwie die zugehörigen Pdf Datein in einem Ordner finden und gefundenen Dateien dann in einen neuen Ordner verschieben soll.
Achtung: Die Pdf heißt 12345XXX.pdf  und ich habe immer nur die Nummer zur verfügung 12345

Danke Danke

[chris-ka]

Hi,

ch wollte mal nachfragen ob mir jemand eventuell mit einem vorhanden Code helfen könnte. 

https://www.google.at/search?source=hp&ei=mg7rWsnFFMGyswH_t564Bw&q=pdf+in+einen+ordner+verschieben+excel+vba&oq=pdf+in+einen+ordner+verschieben+excel+vba&gs_l=psy-ab.3...6270.17900.0.18186.46.42.3.0.0.0.239.4496.15j25j1.42.0....0...1.1.64.psy-ab..1.42.4352.6..0j35i39k1j0i131k1j0i13k1j0i13i30k1j0i22i30k1j33i22i29i30k1j0i22i10i30k1j33i21k1j33i160k1.115.AfoABN-Q4_8

da ist einiges an Code vorhanden, schon im ersten Treffer.

[PhilippB]

Naja ich suche etwas was auch funktioniert.
Vllt sollte ich kurz erwähnen das ich auch sehr wenig ahnung von VBA habe und hatte gedacht auf diese Weg um Hilfe zu bitte.

[chris-ka]

Hallo Philipp

Naja ich suche etwas was auch funktioniert. 

Was funktioniert bei den Codes nicht?

Bezogen auf deine Frage:

ob mir jemand eventuell mit einem vorhanden Code helfen könnte.

Das war vorhandener Code!
Also suchst du keinen vorhandenen Code, sondern jemand der Dir einen neuen Code schreibt.

Ich habe zwar ein wenig Ahnung von VBA, aber ich kann nicht hellsehen. (eine dem original ähnliche Bsp.Mappe wäre hilfreich!)

Mit deinen bisherigen Angaben kann ich keinen funktionierenden Code erzeugen, der jetzt für deine Aufgabe passen würde.
Aber wer weiß...,  es gibt ja viele andere Helfer hier und ggf. kann jemand aushelfen.

[PhilippB]

Ich sage es mal direkt weil anders versteht ihr beiden das hier auch nicht.
Ich habe euch um Hilfe gebeten weil das was mir Google liefert nicht sofort geklappt hatte. Jeder Code ist unterschiedlich und für eine (auch das erwähnte ich) Leihe wie mich deshalb schwer nachzuvollziehen. Aber anyway.

Ihr macht euch hier den Aufwand mich hier anzugehen anstatt wirklich mal zu helfen. Ich schreibe das dann mal wieder als Typisch Deutsche Arroganz ab.
Ihr beiden braucht mir auch nicht weiterhelfen weil mehr als Worte sehe ich in einem Forum was für Hilfe ausgelegt ist leider nicht. (Das soll auch keine Diskussion weiter werden)

In diesem Sinne vielen Dank und noch ein frohes schaffen.

[WillWissen]

Hallo Philipp,

bitte erst kurz nachdenken, bevor hier Helfer unrechtmäßig angegriffen werden.

Ich sage es mal direkt weil anders versteht ihr beiden das hier auch nicht.

Es hat nur ein einziger Helfer (das aber zweimal) konkrete Hilfe angeboten.
Chris hat dir eine Seite verlinkt, auf der du das Gesuchte finden kannst. Falls du beim Ausprobieren des/der gefundenen Codes nicht weiterkommst, solltest du dann nach Vorstellung des Makros deine weiteren Fragen gezielt stellen. In seinem zweiten Beitrag hat dir Chris Fragen gestellt, die du nicht beantwortet hast. So kannst du keine Hilfe bekommen - je detaillierter die Angaben sind umso adäquater wird auch der Lösungsvorschlag sein.

[PhilippB]

Hier ist der Finale Code welcher super funktioniert. Für Leute die schnelle Lösungen brauchen.

Code:

Option Explicit

Sub PDFs_suchen()
 Dim anzVerschoben As Long
 Dim fil As File
 Dim folQ As Folder  ' Quelle
 Dim folZ As Folder  ' Ziel
 Dim fso As FileSystemObject
 Dim letzteZeile As Long
 Dim suchBegriff As String
 Dim suchMuster As String
 Dim verzQuelle As String
 Dim verzZiel As String
 Dim wb As Workbook
 Dim ws As Worksheet
 Dim zeile As Long
 Dim zf As String
 
 Set wb = ThisWorkbook
 verzQuelle = "C:\Users\Philipp\Desktop\*"      ' <-- Hier das gewünschte Verzeichnis einsetzen
 verzZiel = "C:\Users\Philipp\Desktop\*" ' <-- Hier das gewünschte Verzeichnis einsetzen
 
 Set ws = wb.Worksheets(1)
 ws.Columns("B").ClearContents
 letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 Set fso = New FileSystemObject
 If Not fso.FolderExists(FolderSpec:=verzQuelle) Then
   MsgBox verzQuelle & " existiert nicht"
   Exit Sub
 End If
 If Not fso.FolderExists(FolderSpec:=verzZiel) Then
   MsgBox verzZiel & " existiert nicht"
   Exit Sub
 End If
 Set folQ = fso.GetFolder(FolderPath:=verzQuelle)
 Set folZ = fso.GetFolder(FolderPath:=verzZiel)
 For zeile = 2 To letzteZeile
   suchBegriff = ws.Cells(zeile, "A")
   suchMuster = UCase$(suchBegriff & "*.pdf")
   anzVerschoben = 0
   For Each fil In folQ.Files
     If UCase$(fil.Name) Like suchMuster Then
       fil.Move Destination:=verzZiel
       anzVerschoben = anzVerschoben + 1
     End If
   Next fil
   ws.Cells(zeile, "B") = anzVerschoben
 Next zeile
 Set fso = Nothing
End Sub