Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateiname aus Zelle öffnen

Dateiname aus Zelle öffnen
14.10.2016 20:14:20
gerhard
Hallo,
Bitte um VBA Hilfe!
Im Verzeichnis: D:\Messdaten\QM\.......
sind nach Jahreszahl tausende von .xls Messdaten abgelegt.
siehe Anhang:
Die Messdaten werden gespeichert nach Datum und Zeitstempel
z.B.
2016-10-14_1852.xls
Im Verzeichnis Übersicht sind alle Dateinamen aller Jaheszahlen ab Spalte B2 abgelegt!
Nun meine Frage:
Wie kann ich die aktuell markierte Zelle mit dem Inhalt des Dateinamens auslesen
und diese Datei aus allen Jahres-Unterverzeichnissen suchen und dann anschließend öffnen?
Vielen Dank für Eure Hilfe
Gruß Gerhard
Userbild

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

Betreff
Datum
Anwender
Anzeige
AW: Dateiname aus Zelle öffnen
14.10.2016 21:23:09
fcs
Hallo Gerhard,
mit dem folgenden Makro kannst du den Namen in der Zelle auswerten und die Datei im entsprechenden Verzeichnis öffnen. Das Makro speicherst du in einem allgemeinen Modul der datei mit dem Blatt "Übersicht"
Sub MessdatenDateiOeffen()
Dim wks As Object
Dim strPfad As String
Dim strDatei As String
Dim Zelle As Range
Dim wkb As Workbook
Set wks = ActiveSheet
If wks.Name = "Übersicht" Then 'Blattname ggf. anpassen
Set Zelle = ActiveCell
If Zelle.Row >= 2 And Zelle.Column = 2 And Zelle  "" Then
strPfad = "D:\Messdaten\QM\"
'            strPfad = "C:\Users\Public\Test\QM\"
If Dir(Left(strPfad, Len(strPfad) - 1), vbDirectory) = "" Then
MsgBox "Pfad" & vbLf & strPfad & vbLf & "existiert nicht"
Exit Sub
End If
strDatei = Zelle.Text
strPfad = strPfad & Left(strDatei, 4)
If Dir(strPfad, vbDirectory) = "" Then
MsgBox "Pfad" & vbLf & strPfad & vbLf & "existiert nicht"
Exit Sub
End If
strPfad = strPfad & "\" & strDatei
If Dir(strPfad)  "" Then
'Messdatendatei schreibgeschützt öffnen"
Set wkb = Application.Workbooks.Open(strPfad, ReadOnly:=True)
'Variable wkb verwenden, wenn mit der Datei weitere Aktionen durchgeführt  _
werden sollen.
Else
MsgBox "Die Datei " & vbLf & strPfad & vbLf _
& "wurde nicht gefunden!"
End If
Else
MsgBox "Bitte vor dem Start des Makros eine Zelle in Spalte B " _
& "mit einem Dateinamen selektieren!"
End If
Else
MsgBox "Dieses Makro ""MesdatenDateiOeffnen"" nur ausführen, wenn " _
& "Blatt ""Übersicht"" aktiv ist."
End If
End Sub
Wenn du zusätzlich das folgende Makro im VBA-Editor unter dem Tabellen-Modul des Blatts "Übersicht" anlegst, dann kannst du per Rechte-Maus-Klick auf die Zelle mit dem Dateinamen die Datei öffnen.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 And Target.Cells.Count = 1 Then 'Spalte B - 1 Zelle selektiert
If Target.Row >= 2 Then
Call MessdatenDateiOeffen
Cancel = True
End If
End If
End Sub
LG
Franz
Anzeige
AW: Dateiname aus Zelle öffnen
15.10.2016 09:36:55
gerhard
Hallo Franz,
Vielen Dank für Deine schnelle Hilfe!
Ich habe Dein Makro vorab einmal getestet und es funktioniert auf Anhieb soweit super!!
Ich muss aber noch weitere Test's durchführen um es im Qualitätsmanagement (QM) einsetzen zu können!
Aber erstmals vielen Dank für Deine Hilfe!
Gruß
Gerhard
AW: Dateiname aus Zelle öffnen
15.10.2016 18:46:35
gerhard
Hallo Franz,
ich habe heute dein Programm etwas ausführlicher getestet und da sind mir folgendes aufgefallen:
Es gibt doch etliche Messdaten die werden nicht nach dem Datum und Zeit Shema abgespeichert sondern
die werden mit einem individuellen Namen (manuell) abgespeichert!
Diese Dateien werden mit dem Programm nicht gefunden und geladen!!
Ist es möglich das Programm so zu gestallten, dass dem tatsächlichen Dateinamen in der aktiven Zelle
in den Unterverzeichnissen ab D:\Messdaten\QM\..... gesucht und geöffnet wird?
Vielen Dank
Gruß Gerhard
Anzeige
AW: Dateiname aus Zelle öffnen
16.10.2016 09:21:51
fcs
Hallo Gerhard,
ich hab das Makro mal entsprechend umgestrickt.
Dabei wird zunächst die Datei nach dem bisherigen Schema in dem aus dem Dateinamen ermittelten Jahresordner gesucht.
Ist der Name nicht beginnend mit der Jahreszahl oder wird die Datei nicht gefunden, dann wird die Datei in einer Schleife in den Jahresordnern gesucht.
Das Startjahr der Schleife musst du im Makro noch setzen, ich hab mal 2012 genommen.
Gruß
Franz
Sub MessdatenDateiOeffen()
Dim wks As Object
Dim strPfadQM As String
Dim strPfadJahr As String
Dim strPfadDatei As String
Dim strDatei As String
Dim strJahr As String
Dim Zelle As Range
Dim bolDatei As Boolean
Dim bolPfad As Boolean
Dim intJahr As Integer
Dim wkb As Workbook
Set wks = ActiveSheet
If wks.Name = "Übersicht" Then 'Blattname ggf. anpassen
Set Zelle = ActiveCell
If Zelle.Row >= 2 And Zelle.Column = 2 And Zelle  "" Then
bolPfad = False
bolDatei = False
strPfadQM = "D:\Messdaten\QM\"
If Dir(Left(strPfadQM, Len(strPfadQM) - 1), vbDirectory) = "" Then
MsgBox "Pfad" & vbLf & strPfadQM & vbLf & "existiert nicht"
Exit Sub
End If
strDatei = Zelle.Text
strJahr = Left(strDatei, 4)
If IsNumeric(strJahr) Then
'Suche in dem Unterverzeichnis mit dem aus dem Dateinamen ermittelten Jahr
strPfadJahr = strPfadQM & strJahr
bolPfad = Dir(strPfadJahr, vbDirectory)  ""
If bolPfad = True Then
strPfadDatei = strPfadJahr & "\" & strDatei
bolDatei = Dir(strPfadDatei)  ""
End If
End If
If bolDatei = False Or bolPfad = False Then
'Datei in den Jahresordnern suchen
For intJahr = 2012 To Year(Date)                'Startjahr der Schleife ggf.  _
anpassen
strPfadJahr = strPfadQM & Format(intJahr, "0000")
If Dir(strPfadJahr, vbDirectory)  "" Then
If Dir(strPfadJahr & Application.PathSeparator & strDatei)  "" Then
bolPfad = True
bolDatei = True
strPfadDatei = strPfadJahr & "\" & strDatei
Exit For
End If
End If
strPfadJahr = ""
Next
End If
If bolDatei = True Then
'Messdatendatei schreibgeschützt öffnen"
Set wkb = Application.Workbooks.Open(strPfadDatei, ReadOnly:=True)
'Variable wkb verwenden, wenn mit der Datei weitere Aktionen durchgeführt _
werden sollen.
Else
MsgBox "Die Datei " & vbLf & strDatei & vbLf _
& "wurde nicht gefunden!"
End If
Else
MsgBox "Bitte vor dem Start des Makros eine Zelle in Spalte B " _
& "mit einem Dateinamen selektieren!"
End If
Else
MsgBox "Dieses Makro ""MessdatenDateiOeffnen"" nur ausführen, wenn " _
& "Blatt ""Übersicht"" aktiv ist."
End If
End Sub

Anzeige
AW: Dateiname aus Zelle öffnen
16.10.2016 10:05:02
gerhard
Hallo Franz,
Vielen Dank für deine Hilfe!
Aber wie schon erwähnt sollte sich die Suche sowohl der Dateinamen als auch die Namen der Unterverzeichnisse ab D:\Messdaten\QM\...(variable Unterverzeichnisse)
auch mit variablen Namen funktionieren!!
Nach Rücksprache mit QM werden auch Messdaten ausgewertet und diese mit individuellen Dateinamen in ebenfalls individuellen Namen von Unterverzeichnissen neu an und abgelegt!Und diese Dateien müssen bei der Suche ebenfalls berücksichtigt werden!
Gruß Gerhard
AW: Dateiname aus Zelle öffnen
16.10.2016 17:48:21
fcs
Hallo Gerhard,
ich hatte nicht bemerkt, dass die Bezeichnungen der Unterordner auch anders als Jahreszahlen sein können.
Hier jetzt dass Ganze angepasst, so dass die Datei in allen Unterordnern gesucht wird.
Die Liste der Unterordner wird dabei nur beim öffnen der 1. Datei erstellt und in einer Variablen gespeichert. Das beschleunigt ggf. das Öffnen weiterer Dateien.
Sollten in der Übersicht in Spate B identische Dateinamen vorkommen, dann wird immer die 1. gefundene Datei geöffnet. Du müsstest deine Liste auf doppelte prüfen und die Dateinamen ggf. anpassen.
LG
Franz
'Code in einem allgemeinen VBA-Modul der Datei
Option Explicit
Public plFolder As Long, parrFolders() As String
Sub ListFoldersInFolder(ByVal SourceFolderName As String, _
Optional IncludeSubfolders As Boolean = False, _
Optional FolderName As Boolean = False)
'1.Parameter Ordner, wo soll gesucht werden?
'2.Parameter mit Unterordner = True, Optional False ist ohne
'3.Parameter kompl. Pfad ausgeben = True, Optional nur Ordnername = False
'Erstellt ein Array mit den Unterordnern - optional inkl. Pfad
Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo Err_Zugriff: 'sollte Ordner geschützt sein
For Each FileItem In SourceFolder.subFolders
plFolder = plFolder + 1
ReDim Preserve parrFolders(1 To plFolder)
parrFolders(plFolder) = IIf(FolderName, FileItem, FileItem.Name)
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subFolders
ListFoldersInFolder SubFolder.Path, IncludeSubfolders, FolderName
Next SubFolder
End If
Err_Zugriff:
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Sub MessdatenDateiOeffen()
Dim wks As Object
Dim strPfadQM As String
Dim strPfadOrdner As String
Dim strPfadDatei As String
Dim strDatei As String
Dim strJahr As String
Dim Zelle As Range
Dim bolDatei As Boolean
Dim bolPfad As Boolean
Dim arrOrdner, intOrdner As Integer
Dim wkb As Workbook
Set wks = ActiveSheet
If wks.Name = "Übersicht" Then 'Blattname ggf. anpassen
Set Zelle = ActiveCell
If Zelle.Row >= 2 And Zelle.Column = 2 And Zelle  "" Then
bolPfad = False
bolDatei = False
strPfadQM = "D:\Messdaten\QM\"
If Dir(Left(strPfadQM, Len(strPfadQM) - 1), vbDirectory) = "" Then
MsgBox "Pfad" & vbLf & strPfadQM & vbLf & "existiert nicht"
Exit Sub
End If
strDatei = Zelle.Text
strJahr = Left(strDatei, 4)
If IsNumeric(strJahr) Then
'Suche in dem Unterverzeichnis mit dem aus dem Dateinamen ermittelten Jahr
strPfadOrdner = strPfadQM & strJahr
bolPfad = Dir(strPfadOrdner, vbDirectory)  ""
If bolPfad = True Then
strPfadDatei = strPfadOrdner & "\" & strDatei
bolDatei = Dir(strPfadDatei)  ""
End If
End If
If bolDatei = False Or bolPfad = False Then
'Datei in allen Ordnern suchen
If plFolder = 0 Then
'Liste der Ordner wird einmalig nach dem Öffnen der Datei erstellt
Call ListFoldersInFolder(SourceFolderName:=Left(strPfadQM, Len(strPfadQM) -  _
1), _
IncludeSubfolders:=True, _
FolderName:=True)
End If
For intOrdner = 1 To plFolder
strPfadOrdner = parrFolders(intOrdner)
If Dir(strPfadOrdner & Application.PathSeparator & strDatei)  "" Then
bolPfad = True
bolDatei = True
strPfadDatei = strPfadOrdner & "\" & strDatei
Exit For
End If
strPfadOrdner = ""
Next
End If
If bolDatei = True Then
'Messdatendatei schreibgeschützt öffnen"
Set wkb = Application.Workbooks.Open(strPfadDatei, ReadOnly:=True)
'Variable wkb verwenden, wenn mit der Datei weitere Aktionen durchgeführt _
werden sollen.
Else
MsgBox "Die Datei " & vbLf & strDatei & vbLf _
& "wurde nicht gefunden!"
End If
Else
MsgBox "Bitte vor dem Start des Makros eine Zelle in Spalte B " _
& "mit einem Dateinamen selektieren!"
End If
Else
MsgBox "Dieses Makro ""MessdatenDateiOeffnen"" nur ausführen, wenn " _
& "Blatt ""Übersicht"" aktiv ist."
End If
End Sub

Anzeige
AW: Dateiname aus Zelle öffnen
17.10.2016 14:18:42
gerhard
Hallo Franz,
Vielen Dank jetzt passt es!
Gruß
Gerhard

148 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige