Office: Einfache Datenbank zum Suchen und Öffnen von Dokumentdateien

Hallo Office-Gemeinde,

ich bin komplett neu hier, Newbie im Bereich Access-Datenbanken, und möchte mich an einem kleinen Projekt versuchen - in der Hoffnung, dass das so überhaupt realisierbar ist.

Ausgangslage: In einem Verzeichnis liegen PDF- und Word-Datei-Paare mit jeweils dem gleichen Dateinamen, z.B. 12345678.pdf bzw 12345678.docx.

Ziel: Nach Eingabe einer solchen Dateibezeichnung (z.B. 12345678) in ein Suchfeld soll das jeweilige gleichheißende Dateipaar automatisch und gleichzeitig mit dem für den Dateityp registrierten Programm (Acrobat Reader/MS Word) geöffnet werden.
Bei Falscheingabe/nicht vorhander Dateibezeichnung sollte idealer Weise ein Hinweis kommen.

Wäre so etwas machbar? Falls ja, wie wären die ersten Schritte zur Einrichtung einer entsprechenden Datenbank?

Danke und Gruß
BM22

 

Moin BM22
warum willst Du dafür eine Datenbank bauen? Hast Du mit den Dateilisten noch was vor?
Geht das nicht mit Excel? (Deine bisherigen Anforderungen schon)
Gruß
Doming

 

Hi Doming,
nee, mit der Dateiliste vorerst nicht mehr als das.
Eine Luxusfunktion wäre ggf. noch, dass ursprünglich nur die PDF-"Version" der Datei existiert und beim Suchen und Öffnen von dieser dann automatisch eine neue Docx erstellt und geöffnet wird (so noch nicht vorhanden).
Mit Excel hatte ich schon etwas rumprobiert, mich dann aber irgendwo bei den Makros/VB verstrickt.
Gerne auch Excel als Lösung, wenn das dort einfach machbar und auch optisch mit einer Art Eingabemaske oder so realisierbar wäre... aber das ist dann hier ja sicher das falsche Unterforum...

 

Hallo,

in der beiliegenden Excel-Datei habe ich dir im Codemodul des Arbeitsblattes "Tabelle1" das folgende ereignisgesteuerte Makro eingefügt:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Me.Range("B5")) Is Nothing Then Exit Sub
  
   'Nur wenn Target (sich ändernde Zelle) in B5
  
   Dim Pfad As String, Datei As String
   Dim DateiPDF As String, DateiDOC As String
   Dim strMsg As String, ctMsg As Integer, Msg() As String
  
   With Me
     Pfad = .Range("A4").Value   'Pfad in Zelle A4
     Datei = .Range("B5").Value  'Dateiname in Zelle B5
   End With
   DateiPDF = Pfad & "\" & Datei & ".PDF"  'PDF-Datei  samt Pfad
   DateiDOC = Pfad & "\" & Datei & ".DOCX" 'DOCX-Datei samt Pfad
  
   strMsg = ""
   If Len(Dir(DateiPDF)) Then
      'Die PDF-Datei wird im Acrobat-Reader geöffnet
      ActiveWorkbook.FollowHyperlink DateiPDF
   Else
      strMsg = strMsg & DateiPDF & vbNewLine
   End If
   If Len(Dir(DateiDOC)) Then
      'Die DOCX-Datei wird in MS-Word geöffnet
      ActiveWorkbook.FollowHyperlink DateiDOC
   Else
      strMsg = strMsg & DateiDOC & vbNewLine
   End If
  
   If Len(strMsg) Then
      'Mindestens eine der beiden Dateien konnte nicht geöffnet werden.
      Msg = Split(strMsg, vbNewLine): ctMsg = UBound(Msg)
      If ctMsg = 2 Then
         strMsg = "Die Dateien" & vbNewLine & strMsg & "konnten" ' nicht geöffnet werden."
      Else
         strMsg = "Die Datei" & vbNewLine & strMsg & "konnte" ' nicht geöffnet werden."
      End If
      strMsg = strMsg & " nicht gefunden/geöffnet werden."
      MsgBox Prompt:=strMsg, Title:="Nicht gefundene Datei" & IIf(ctMsg = 2, "en", "")
   End If
  
End Sub

Dieses Makro erwartet den Dateipfad in der Zelle A4 und den Dateinamen (ohne PDF bzw. DOCX) in Zelle B5.
Sobald sich der Zellinhalt von B5 ändert, startet das Makro und zeigt den Dateinamen von Zelle B5 einerseits im Acrobat-Reader (PDF-Datei) als auch als Word-Datei (DOCX-Datei) an.
Fehlt jedoch die PDF-Datei bzw. die DOCX-Datei (oder auch beide), weist ein MsgBox-Fenster auf diesen Umstand hin.

 

Moin Exl,
danke für den Aufwand und die Superarbeit!
Werde mich gleich mal dranmachen und gucken, wie ich das zum Laufen kriege! :-)

 

Danke noch mal, Exl - das funktioniert super! :-)

Hätte zusätzlich ein Luxusfrage: Könnte man das Ganze auch noch so erweitern, dass bei Suche und Start einer PDF - sollte noch keine namensgleiche DOCX-Datei im Verzeichnis liegen - statt der Fehlermeldung jetzt vom Script eine entsprechende neue leere DOCX mit dem Namen der PDF im Verzeichnis angelegt und geöffnet wird?

Danke und VG,
BM22

 

Hallo,

ich habe das Makro in der beiliegenden Datei angepasst.

 

Vielen Dank schon mal!
Nach dem ersten Test macht das Makro aber noch genau das Gleiche -> bei fehlender DOCX kommt die Meldung und Word öffnet sich nicht...Muss da im Makro/Modul noch was angepasst werden?

 

Hallo,

nein.
Aber nach deinen Vorgaben muss Excel zuerst eine existierende PDF-Datei finden - Falls dann kein namensgleiches Word-Dokument vorliegt, soll Word gestartet werden und ein leeres Word-Dokument unter diesem Namen gespeichert werden. Es erscheint eine modifizierte Meldung, dass das Word-Dokument, da es nicht gefunden wurde, als "=leeres Dok." geöffnet wurde.
Dieser Vorgang kann etwas dauern, je nachdem wie deine Konfiguration aussieht.

Code:

'....
Prüfe_auf_DOC_Datei:
   If Len(Dir(DateiDOC)) Then
      'Die DOCX-Datei wird in MS-Word geöffnet
      ActiveWorkbook.FollowHyperlink DateiDOC
   Else
     'WinWord starten mit neuem, leerem Word-Dokument
      If WordDokument(DateiDOC) Then
         strMsg = strMsg & DateiDOC & " = leeres Dok." & vbNewLine
         GoTo Prüfe_auf_DOC_Datei
      Else
         strMsg = strMsg & DateiDOC & vbNewLine
      End If
   End If
'....

wobei der Funktionsaufruf "WordDokument(DateiDOC)" in folgender benutzerdef.Funktion enthalten ist:

Code:

   '
   'WinWord starten mit neuem, leerem Word-Dokument
   '
Function WordDokument(DateiPfadName As String) As Boolean

   Dim wApp As Object  'New Word.Application
   Dim wDoc As Object  'Word.Document
 
   WordDokument = False
   On Error GoTo Exit_Word
   Set wApp = CreateObject("Word.Application")    'Instanz der WinWord-Anwendung
 
   Set wDoc = wApp.Documents.Add(Visible:=True)   'Worddokument ("leeres" Dok.)
   wDoc.SaveAs2 Filename:=DateiPfadName           'wird in Datei gespeichert
   wDoc.Close                                     'Worddokument wird geschlossen
   WordDokument = True
 
Exit_Word:
   wApp.Quit                                      'Word-Instanz wird beendet und
   Set wApp = Nothing                             'Garbage-Collection im Heap wird ermöglicht.
 
End Function

 

Hmm - es erscheint exkat die gleiche Meldung wie vor der Modifikation, und Word öffnet auch nach Warten nicht.
Hier mal das Bild bei vorhandener 1492010.pdf (diese öffnet), dann die Meldungsbox wie gehabt wegen der fehlenden DOC-Datei:


Mehr passiert nicht... (?)

 

Hallo,

das kann ich nicht nachvollziehen. Es muss ferner die Meldung in der Messagebox lauten:
Die Datei
C:\Artikel_DB\1492010.DOCX = leere Dok.
konnte nicht gefunden/geöffnet werden.

Im Folgenden nochmal die VBA-Programme, die im Codemodul des aktiven Arbeitsblattes enthalten sein müssen:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Me.Range("B5")) Is Nothing Then Exit Sub
 
   'Nur wenn Target (sich ändernde Zelle) in B5
 
   Dim Pfad As String, Datei As String
   Dim DateiPDF As String, DateiDOC As String
   Dim strMsg As String, ctMsg As Integer, Msg() As String
 
   With Me
     Pfad = .Range("A4").Value   'Pfad in Zelle A4
     Datei = .Range("B5").Value  'Dateiname in Zelle B5
   End With
   DateiPDF = Pfad & "\" & Datei & ".PDF"  'PDF-Datei  samt Pfad
   DateiDOC = Pfad & "\" & Datei & ".DOCX" 'DOCX-Datei samt Pfad
   strMsg = ""

Prüfe_auf_PDF_Datei:
   If Len(Dir(DateiPDF)) Then
      'Die PDF-Datei wird im Acrobat-Reader geöffnet
      ActiveWorkbook.FollowHyperlink DateiPDF
   Else
      strMsg = strMsg & DateiPDF & vbNewLine
   End If
 
Prüfe_auf_DOC_Datei:
   If Len(Dir(DateiDOC)) Then
      'Die DOCX-Datei wird in MS-Word geöffnet
      ActiveWorkbook.FollowHyperlink DateiDOC
   Else
     'WinWord starten mit neuem, leerem Word-Dokument
      If WordDokument(DateiDOC) Then
         strMsg = strMsg & DateiDOC & " = leeres Dok." & vbNewLine
         GoTo Prüfe_auf_DOC_Datei
      Else
         strMsg = strMsg & DateiDOC & vbNewLine
      End If
   End If
 
Prüfe_auf_Message:
   If Len(strMsg) Then
      'Mindestens eine der beiden Dateien konnte nicht geöffnet werden.
      Msg = Split(strMsg, vbNewLine): ctMsg = UBound(Msg)
      If ctMsg = 2 Then
         strMsg = "Die Dateien" & vbNewLine & strMsg & "konnten" ' nicht geöffnet werden."
      Else
         strMsg = "Die Datei" & vbNewLine & strMsg & "konnte" ' nicht geöffnet werden."
      End If
      strMsg = strMsg & " nicht gefunden/geöffnet werden."
      MsgBox Prompt:=strMsg, Title:="Nicht gefundene Datei" & IIf(ctMsg = 2, "en", "")
   End If
 
End Sub
   '
   'WinWord starten mit neuem, leerem Word-Dokument
   '
Function WordDokument(DateiPfadName As String) As Boolean

   Dim wApp As Object  'New Word.Application
   Dim wDoc As Object  'Word.Document
 
   WordDokument = False
   On Error GoTo Exit_Word
   Set wApp = CreateObject("Word.Application")    'Instanz der WinWord-Anwendung
 
   Set wDoc = wApp.Documents.Add(Visible:=True)   'Worddokument ("leeres" Dok.)
   wDoc.SaveAs2 Filename:=DateiPfadName           'wird in Datei gespeichert
   wDoc.Close                                     'Worddokument wird geschlossen
   WordDokument = True
 
Exit_Word:
   wApp.Quit                                      'Word-Instanz wird beendet und
   Set wApp = Nothing                             'Garbage-Collection im Heap wird ermöglicht.
 
End Function

 

Danke für die Mühe, aber immer noch das Gleiche. :-(
Die modifizierte Variante funktioniert quasi genauso wie die erste. Der Code steht exakt so drinnen; ich habe den auch noch mal in beide frisch runtergeladenen Versionen reingepackt - unverändert.
Kann es sein, dass meine Excelversion (noch 2007) damit ein Problem hat? Oder irgendeine Einstellung dazwischenfunkt?

Hatte die .xlsm beide zum Testen erstmal so gelassen, wie sie waren (Ergebnis immer wie oben).
Dann schon mal ein Formular gebaut mit Suchfeld, gesperrten Zellen, gewünschter Größe etc., so, wie's eigentlich mal aussehen soll - das funktioniert alles, aber immer nur nach der ursprünglichen Version.

So'n Mist, das Problem kann ja nur eine Kleinigkeit sein...

 

Moin,
des Rätsels Lösung: der zweite Teil funktioniert nicht unter Excel 2007 (Check auf zwei Rechner). Test unter 2010: sofort.
Danke noch mal an Exl für die Mühe!

 

Hallo!
Habe alles noch etwas angepasst und ein geschütztes Eingabeformular erstellt, das in definierter Größe und Position startet, alles funktioniert soweit auch super.
Was nur vom Handling einen Tick umständlich ist: das Word öffnet immer exakt in gleicher Fenstergröße hinter dem Excel-Fenster (die PDF im Acrobat Reader in Vollbild vor allem, das ist ok so) und muss extra vorgefischt werden...
Kann man das Word zwingen, in Vollbild oder bestimmter Größe und Position (ggf. auf zweitem Monitor) zu öffnen?
Entsprechende Fenstereinstellungen über ein Word-Makro funktionieren zwar, aber nur bei manuellem Solostart von Word - bei Aufruf über das Excel-Makro nicht, dort immer wie oben beschrieben...
Danke und VG, bm22