Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Application.FileSearch in Office 2007?

Frage Microsoft Microsoft Office

Mitglied: Zockerman

Zockerman (Level 1) - Jetzt verbinden

11.11.2010 um 12:39 Uhr, 4446 Aufrufe, 1 Kommentar

Applikation.Filesearch ist in Office 2007 nicht mehr vorhanden. Daher suche ich nach einer passenden Alternative.

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
Mitglied: 76109
13.11.2010 um 13:55 Uhr
Hallo Christian!

Du könntest es mal mit diesem Code versuchen:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const Msg1 = "Es wurde mehr als eine passende Datei zu %1.pdf gefunden. Bitte manuell verknüpfen." 
05.
Const Msg2 = "Es wurde keine passende Datei zu %1.pdf gefunden." 
06.
 
07.
Dim Fso As Object, FileList As Object 
08.
 
09.
Sub SetHyperlinks() 
10.
    Dim Dlg As FileDialog, File As Variant, c As Range 
11.
    Dim Path As String, SearchName As String, FoundCount As Long 
12.
    
13.
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker) 
14.
     
15.
    Dlg.Title = "Verzeichnis auswählen..." 
16.
    Dlg.InitialFileName = "D:\Temp\"  'Start-Ordner 
17.
     
18.
    If Dlg.Show = False Then Exit Sub 
19.
     
20.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
21.
    Set FileList = CreateObject("Scripting.Dictionary") 
22.
    
23.
    Call InitFileList(Fso.GetFolder(Dlg.SelectedItems(1))) 
24.
     
25.
    For Each c In Selection 
26.
        If Not IsEmpty(c) Then 
27.
            FoundCount = 0 
28.
             
29.
            For Each File In FileList.Items 
30.
                If c Like Fso.GetBaseName(File) Then 
31.
                    Path = File:  FoundCount = FoundCount + 1 
32.
                End If 
33.
            Next 
34.
             
35.
            If FoundCount = 0 Then 
36.
                SearchName = c 
37.
                 
38.
                Do While (Mid(SearchName, 3, 1) = "0") 
39.
                    SearchName = Left(c, 2) & Mid(SearchName, 4) 
40.
                     
41.
                    For Each File In FileList.Items 
42.
                        If Fso.GetBaseName(File) Like SearchName Then 
43.
                            Path = File:  FoundCount = FoundCount + 1 
44.
                        End If 
45.
                    Next 
46.
                Loop 
47.
            End If 
48.
                 
49.
            If FoundCount = 1 Then 
50.
                ActiveSheet.Hyperlinks.Add c, Path 
51.
            ElseIf FoundCount > 1 Then 
52.
                MsgBox Replace(Msg1, "%1", c), vbInformation, "Dateisuche..." 
53.
            Else 
54.
                MsgBox Replace(Msg2, "%1", c), vbInformation, "Dateisuche..." 
55.
            End If 
56.
        End If 
57.
    Next 
58.
End Sub 
59.
 
60.
Private Sub InitFileList(ByRef Folder) 
61.
    Dim File As Object, SubFolder As Object 
62.
     
63.
    For Each File In Folder.Files 
64.
        If LCase(Fso.GetExtensionName(File.Name)) = "pdf" Then 
65.
            FileList.Add FileList.Count + 1, File.Path 
66.
        End If 
67.
    Next 
68.
     
69.
    For Each SubFolder In Folder.SubFolders 
70.
        Call InitFileList(SubFolder) 
71.
    Next 
72.
End Sub
Gruß Dieter

PS Dein Code ließe sich in Code-Tags (siehe Formatierungshilfe) auch besser lesen
Bitte warten ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
Windows Netzwerk
gelöst Dateiberechtigung Office 2007 und Office 2013 (3)

Frage von Maverick6 zum Thema Windows Netzwerk ...

Microsoft Office
gelöst Speicherpfade in Office 2007 ändern! (2)

Frage von mike7050 zum Thema Microsoft Office ...

Microsoft Office
Vorinstalliertes Office 2007 "Standard" erneut installieren (2)

Frage von Milchmann89 zum Thema Microsoft Office ...

Microsoft Office
gelöst Dringend: Setup-ISO für Office 2007 Standard (deutsch!) gesucht (17)

Frage von SarekHL zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

DSL, VDSL
DSL-Signal bewerten (10)

Frage von SarekHL zum Thema DSL, VDSL ...

Windows Server
Mailserver auf Windows Server 2012 (8)

Frage von StefanT81 zum Thema Windows Server ...

Backup
Clients als Server missbrauchen? (8)

Frage von 1410640014 zum Thema Backup ...