Application.FileSearch in Office 2007?

Question

Hallo,

das folgende Programm, war dazu da, in unserer Firma, einen markierten Bereich in einer Exceltabelle durchzugehen und dann in einem vorher angegebenen Ordner, nach Dateien des selben Names zu suchen.
Ich hoffe ihr könnt mir helfen, da derjenige der das Makro geschrieben hat, nicht mehr hier ist und nun ich diese Aufgabe bekommen habe.

Mit freundlichen Grüßen
Christian Edel

P.S.: Hier das Makro:
Und schonmal VIELEN DANKE für die Hilfe!!!!

Sub VerknüpfungenErstellen_V3()
Dim pfad As String
'in welchem Verzeichnis liegen die Dokumente?
Dim oSh As Object
Dim oFd As Variant
Dim nS As Object

Set oSh = GetObject("", "Shell.Application")
Set oFd = oSh.BrowseforFolder(0, _
"Bitte ein Verzeichnis auswählen ...", 0, "")
Set nS = oFd.Self
pfad = nS.Path

Set oSh = Nothing


If pfad = "" Then Exit Sub

'Markierte Zellen durchgehen
For Each cell In Selection

gefunden = False



With Application.FileSearch
.NewSearch
.LookIn = pfad
.SearchSubFolders = True
.Filename = cell.Value & ".pdf"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles

If .Execute() > 0 Then
Select Case .FoundFiles.Count
Case 1
'Verknüpfen
'MsgBox "LINK: " & .FoundFiles(1)
ActiveSheet.Hyperlinks.Add cell, .FoundFiles(1)
gefunden = True
Case Else
MsgBox "Es wurde mehr ale eine passende Datei " & cell.Value & ".pdf gefunden. Bitte manuell verknüpfen."
End Select
Else
'MsgBox "Es wurde keine Datei " & cell.Value & ".pdf gefunden."
End If
End With

If Not (gefunden) Then
'mit verkürztem Suchstring (ohne führende Nullen) nochmal durchgehen, falls nichts gefunden wurde.
'Beispiel cell.Value = DE000004006420C5
' suchstring = DE4006420C5
suchstring = cell.Value
While Mid(suchstring, 3, 1) = "0" And Not (gefunden)

'eine Null entfernen..
suchstring = Left(suchstring, 2) & Right(suchstring, Len(suchstring) - 3)

'..und nochmal suchen
With Application.FileSearch
.NewSearch '
.LookIn = pfad
.SearchSubFolders = True
.Filename = suchstring & ".pdf"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles

If .Execute() > 0 Then
Select Case .FoundFiles.Count
Case 1
'Verknüpfen
'MsgBox "LINK: " & .FoundFiles(1)
ActiveSheet.Hyperlinks.Add cell, .FoundFiles(1)
gefunden = True
Case Else
MsgBox "Es wurde mehr ale eine passende Datei " & suchstring & ".pdf gefunden. Bitte manuell verknüpfen."
End Select
Else
MsgBox "Es wurde keine Datei " & suchstring & ".pdf gefunden."
End If
End With

Wend
End If

Next

End Sub

Answer 1

Hallo Christian,

Ordner auslesen ab Version 20047

Gruß Hajo

Answer 2

VIELEN DANK ...
Das ist ja schonmal super.
Jedoch eine frage.
Es soll so sein, dass man einen Zellbereich markiert.
Und dann das Makro dort die Hyperlinks eintrage soll, wo der Dateiname übereinstimmt.

Gruß

Answer 3

Hallo Christian,

interpretiere ich das richtig, es soll kein Ordner ausgelesen werden, sondern nur gerschaut werden ob die Dateien im selektierten Bereich in dem Ordner sind?
Ich bin nicht an meinen Homerechner und kann jetzt den Code nicht für das Problem umschreiben, falls meine Beschreibung richtig ist.

Gruß Hajo

Answer 4

Ja genau.
1. Es wird also ein Bereich in einer ExcelTabelle markiert. Meinet wegen A1:A20
For Each cell In Selection
daher diese Zeile.
2. Dann soll der Ordner der Dateien angegeben werden. + Unterordner
3. Es soll geprüft werden. Ob eine Datei im Angegebnen Ordner genau so heißt wie eine value in einer Zelle+.pdf
Die Dateien habe standartmäßig dieses Format DE000010003656B4.pdf es kann abe auch vorkommen, dass sie so heißen, DE10003656B4 also einfach 0000 weg. Daher die zweite abprüfung im Code.
Dann sind nur noch so Randbedingungen zu klären, wie wenn eine Datei 2 mal vorhanden ist händisch wählen etc.

Ich hoffe ich habe es einigermaßen verständlich erklärt.
Und du wärst ein Gott wenn du mir das so abändern könntest...

Wirklich hammergroßen Dank.

Answer 5

Ach was ich vergessen hab. Sobald eine Übereinstimmung gefunden wurde, soll die Zelle aus der der Dateiname stammt mit dem Hyperlink überschrieben werden .

Answer 6

Hallo Christian,

das übersteigt nun doch meine Zeitkontigent.
Das verlinkten der Dateien im Bereich ist wahrscheibnlich ohne großen Aufwand möglich.
Das mit 0000 und ohne vielleicht auch noch. Aber das mit den Doppelten Dateien ist mir dann doch zu aufwendig.

Gruß Hajo

Answer 7

Hallo Hajo,

hm ... also es würde mir eigentlich reichen, wenn Sie mir das Grundgerüst schreiben würden. Also ohne die doppelten Dateien abzufangen. Ich würde dass dann dazuschreiben, da ich das relativ einfach sehe. Die Funktion hat ja sicher einen rückgabewert, wenn etwas gefunden wird. Wenn ich jedesmal eins hochzähle, wenn er was findet ...
Aber ich wäre ihnen wirklich dankbar, da ich einfach nicht klarkomme ...

Gruß Christian,

Answer 8

Hallo Hajo,

Mir is grad aufgfallen, dass ich a depp bin :)
Warum abfrage, ob es mehrer Dateien gibt. Is ja sinnlos. Ich habe ja die exakten namen der dateien und man kann sowieso nicht mehr als eine datei eines dateinnames haben.
Also wenn du die unendliche güte besäßest, mir das so abzuändern.
Das wär echt super. Ich habe nur relativ wenig erfahrung mit vba.
Schonmal zwischendurch vielen dank für deine hilfe und deine zeit.

Gruß Christian

Answer 9

Hallo Christian,

wie schon geschrieben muss ich dazu an meinem Home Rechner sitzen, am Nachmittag.
Das hochzählen hätte ich nicht als so einfach empfunden.
Es wird die Datei ausgelesen, gesucht ob sie im dem Bereich ist, dann Hyperlink, so sieht mein Konzept aus.
Falls Hyperlink schon vorhanden, dann kein neuer.

Gruß Hajo

Answer 10

Hallo Hajo,

es hat Zeit. Also nicht hetzen. Ich bin ja so schon megafroh, dass ich eine Lösung gefunden habe.
Tja wenns der Chef net kann machts halt der Azubi ;)
Spaß beseite, wirklich vielen Dank und deine Seite ist wirklich gut .

Gruß Christian