Word Dokument durch Such in Ordnern find

Sub Dateienausgeben(ByVal Ordner As Object) Dim DatOrd As Variant, Datei As Object Dim Name, Unterordner, Dokumente As String Dim Subfolders As Folders Dim Subfolder As Object Name = "To do Wiki.docx" For Each Datei In Ordner.Files 'Ordner If Datei.Name = Name Then Dim oAppWD As Object, oDoc As Object Set oAppWD = CreateObject("Word.Application") 'Word als Object starten If Not oAppWD Is Nothing Then End If oAppWD.Visible = True If oAppWD.Options.AllowReadingMode = True Then 'Word nicht im Lesemodus starten bei _ Schreibgeschützten Dokumenten oAppWD.Options.AllowReadingMode = False End If Set fs = Application.FileDialog(msoFileDialogFolderPicker) With Application.FileDialog(msoFileDialogPicker) If .Show 0 Then Dokumente = .SelectedItems(1) End If End With Set oDoc = oAppWD.Documents.Open(Dokumente) GoTo Skip End If Next For Each DatOrd In Ordner.Subfolders 'Unterordner For Each Datei In DatOrd.Files If Datei.Name = Name Then Set oAppWD = CreateObject("Word.Application") 'Word als Object starten If Not oAppWD Is Nothing Then End If oAppWD.Visible = True If oAppWD.Options.AllowReadingMode = True Then 'Word nicht im Lesemodus starten bei _ Schreibgeschützten Dokumenten oAppWD.Options.AllowReadingMode = False End If Set fs = Application.FileDialog(msoFileDialogFolderPicker) With Application.FileDialog(msoFileDialogPicker) If .Show 0 Then Dokumente = .SelectedItems(1) End If End With Set oDoc = oAppWD.Documents.Open(Dokumente) GoTo Skip End If Next Next Skip: End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Dominik,
hier noch 'ne Variante zum Öffnen einer Datei.
Ich habe hier Shellexecute gewählt, womit die Datei nur (wie hoffentlich gewünscht) geöffnet wird.
Wenn Du sie per Makro weiterverarbeiten willst, brauchen wir die wdApp-Variante...

Option Explicit

Option Compare Text

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

        ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _

        ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Sub FileSearchAndOpen()

'Sub sucht eine Datei incl.Platzhalter in Ordner und Unterordner

 Dim sFilename As String, sPathname As String

 Dim oPath As Object, oFile As Object

 Dim bCheck As Boolean

'Datei incl. Pfad oder Datei und anschließend Start-Pfad abfragen

 sFilename = "C:&bsol;Users&bsol;voltm&bsol;Documents&bsol;Worddokumente&bsol;PBeaKK.docx"

 sFilename = "PB*aKK.docx"

 sFilename = InputBox("Bitte den Dateinamen eingeben!", "Datei suchen und öffnen", sFilename)

 If StrPtr(sFilename) = 0 Then Exit Sub

 If sFilename = "" Then Exit Sub

'Beu fehlender Erweiterung eine Standard-Erw ergänzen

 If Not sFilename Like "*.*" Then sFilename = sFilename & ".docx"

'Wenn kein vollständiger Pfad angegeben, Startpfad abfragen

 If Not sFilename Like "*:*&bsol;*" Then

  With Application.FileDialog(msoFileDialogFolderPicker)

     If .Show &LT;&GT; 0 Then

        sPathname = .SelectedItems(1)

        With CreateObject("scripting.filesystemobject").GetFolder(sPathname)

          On Error Resume Next

'Alle Dateien im Ordner durchsuchen

          For Each oFile In .Files

             If oFile.Name Like sFilename Then

                sFilename = sPathname & "&bsol;" & oFile.Name

                bCheck = True: Exit For

             End If

          Next oFile

'Alle Unterordner durchsuchen

          If bCheck = False Then

             For Each oPath In .Subfolders

'Alle Dateien im Unterordner durchsuchen

               For Each oFile In oPath.Files

                If oFile.Name Like sFilename Then

                   sFilename = oPath.Name & "&bsol;" & oFile.Name

                   bCheck = True: Exit For

                End If

               Next oFile

               If bCheck Then Exit For

             Next oPath

          End If

        End With

     End If

  End With

 End If

'Datei öffnen

 ShellExecute 0&, "Open", sFilename, 0, 0, &H9&  '9=SW_RESTORE

End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Hallo Dominik,
teste mal nachfolgenden Code...

Option Explicit

Option Compare Text

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

        ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _

        ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Dim gsPathFilename As String

Sub FileSearchAndOpen()

 Dim sFilename As String

'Datei incl. Pfad oder Datei und anschließend Start-Pfad abfragen

 sFilename = "To do Wiki.docx"          'Optionale Vorbelegung

 sFilename = InputBox("Bitte den Dateinamen eingeben!", "Datei suchen und öffnen", sFilename)

 If StrPtr(sFilename) = 0 Then Exit Sub 'Abbruch gewählt

 If sFilename = "" Then Exit Sub        'Nix eingegeben

 If Not sFilename Like "*.*" Then sFilename = sFilename & ".docx"

 If Not sFilename Like "*:*&bsol;*" Then     'Kein vollständiger Dateipfad

  With Application.FileDialog(msoFileDialogFolderPicker)

     If .Show &LT;&GT; 0 Then

        gsPathFilename = ""             'Globalen Dateinamen leeren

        GetFile .SelectedItems(1), sFilename

     End If

  End With

 End If

'Datei öffnen,      &H9&=SW_RESTORE, &H3&=SW_MAXIMIZE

 If sFilename &LT;&GT; "" Then ShellExecute 0&, "Open", sFilename, 0, 0, &H9&

End Sub

Sub GetFile(sPathname As String, sSearchFile As String)

 Dim oFile As Object, oDir As Object

 If gsPathFilename &LT;&GT; "" Then Exit Sub  'Suchbegriff gefunden=&GT;raus

 On Error Resume Next

 With CreateObject("scripting.filesystemobject").GetFolder(sPathname)

'Ordner durchsuchen

  For Each oFile In .Files

   If Err = 0 Then

      If oFile.Name Like sSearchFile Then

         gsPathFilename = sPathname & "&bsol;" & oFile.Name

         Exit Sub

      End If

   End If

  Next

'Unterordner durchsuchen

  For Each oDir In .Subfolders

      GetFile sPathname & "&bsol;" & oDir.Name, sSearchFile

  Next

 End With

End Sub

Viele Grüße aus Freigericht
Karl-Heinz

Option Explicit #If Win64 Then Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" _ (ByVal RootPath As String, ByVal InputPathName As String, _ ByVal OutputPathBuffer As String) As Long Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long #Else Private Declare Function SearchTreeForFile Lib "imagehlp.dll" _ (ByVal RootPath As String, ByVal InputPathName As String, _ ByVal OutputPathBuffer As String) As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long #End If Private Const SW_MAXIMIZE = 3 Const strFile As String = "To do Wiki.docx" Public Sub Main() Dim strPathName As String * 255 Dim strVerzeichnis As String Dim strName As String Dim lngTMP As Long On Error GoTo Fin If Ordnerwahl(strVerzeichnis) "" Then lngTMP = SearchTreeForFile(strVerzeichnis, strFile, strPathName) If lngTMP = 0 Then MsgBox "Datei nicht gefunden!" Else strPathName = Left$(strPathName, InStr(1, strPathName, vbNullChar) - 1) strName = RTrim(strPathName) ShellExecute 0, "Open", strName, "", "", SW_MAXIMIZE End If Else MsgBox "Es wurde kein Ordner ausgewaehlt!" End If Fin: If Err.Number 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub Public Function Ordnerwahl(strOrdner As String) As String With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\" .Title = "Ordnerauswahl" .ButtonName = "Auswahl..." .InitialView = msoFileDialogViewList If .Show = -1 Then strOrdner = .SelectedItems(1) If Right(strOrdner, 1) "\" Then strOrdner = strOrdner & "\" End If End With Ordnerwahl = strOrdner End Function

Beliebteste Forumthreads (12 Monate)

Word Dokument durch Such in Ordnern find

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Word Dokument durch Such in Ordnern find

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread