Supportnet / Forum / Tabellenkalkulation
Datei irgendwo auf Laufwerk C öffnen (mit VBA)
Frage
Hallo zusammen,
Kann man per VBA eine „.xls“ Datei suchen und wenn vorhanden öffnen?
Das für mich schwierige dabei ist,dass sich die Datei irgendwo auf Laufwerk
C:\ befindet und ich somit den genauen Pfad im Code nicht angeben kann.
Ich bräuchte also einen Code der das gesamte Laufwerk C nach der Datei
„Auflistung.xls“ durchsucht und öffnet.Wenn nicht vorhanden soll die Meldung:
„Datei nicht gefunden“ angezeigt werden.
Es wäre nett wenn sich jemand ein paar Gedanken darüber macht und
mir mit einen entsprechenden Code antwortet.
Im voraus schon mal ein Danke!
Antwort 1 von JoeKe
Moin Anno,
probier es mal mit folgenden Code:
Option Explicit
Sub Datei_öffnen()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Datei As String, NeueSuche As String
Start:
Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:="C:\")
Datei = InputBox("Welche Datei wird gesucht?")
If Datei = "" Then Exit Sub
If Right(Datei, 4) <> ".xls" Then Datei = Datei & ".xls"
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
NeueSuche = MsgBox("Es wurde keine Datei gefunden!" & Chr(13) & _
"Möchten sie eine neue suche starten?", _
vbYesNo)
If NeueSuche = vbYes Then GoTo Start
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Gruß
JöKe
probier es mal mit folgenden Code:
Option Explicit
Sub Datei_öffnen()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Datei As String, NeueSuche As String
Start:
Pfad = InputBox("Verzeichnis:", "Welches Verzeichnis?", Default:="C:\")
Datei = InputBox("Welche Datei wird gesucht?")
If Datei = "" Then Exit Sub
If Right(Datei, 4) <> ".xls" Then Datei = Datei & ".xls"
If Pfad = "" Then Exit Sub
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
NeueSuche = MsgBox("Es wurde keine Datei gefunden!" & Chr(13) & _
"Möchten sie eine neue suche starten?", _
vbYesNo)
If NeueSuche = vbYes Then GoTo Start
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Gruß
JöKe
Antwort 2 von Anno2005
Hallo,
entschuldigt bitte die späte Antwort!
Der Code läuft prima
Für eine andere Aufgabe hab ich den Code etwas abgewandelt.
Leider läuft er nicht wie ich mir das gedacht habe.
Es erscheint die Meldung :Laufzeitfehler ‚70’ Zugriff verweigert
Die Datei hat die Endung „ .csv“ und ist durch Kommata getrennt
Sie ist auch nicht Schreibgeschützt.
Hier der Code
Sub Wareneingang()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Datei As String, Meldung As String
Pfad = "C:\"
Datei = "Wareneingang.csv"
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
Meldung = MsgBox("Es wurde keine Datei gefunden!", vbOKOnly)
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Was muss geändert werden?
entschuldigt bitte die späte Antwort!
Der Code läuft prima
Für eine andere Aufgabe hab ich den Code etwas abgewandelt.
Leider läuft er nicht wie ich mir das gedacht habe.
Es erscheint die Meldung :Laufzeitfehler ‚70’ Zugriff verweigert
Die Datei hat die Endung „ .csv“ und ist durch Kommata getrennt
Sie ist auch nicht Schreibgeschützt.
Hier der Code
Sub Wareneingang()
Application.ScreenUpdating = False
Dim zähler As Long, Pfad As String, Datei As String, Meldung As String
Pfad = "C:\"
Datei = "Wareneingang.csv"
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.LookIn = Pfad
.SearchSubFolders = True
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
Meldung = MsgBox("Es wurde keine Datei gefunden!", vbOKOnly)
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Was muss geändert werden?
Antwort 3 von JoeKe
Moin Anno,
ich kann leider keinen Fehler finden.
Läst sich die Datei sonst normal öffnen?
Gruß
JöKe
ich kann leider keinen Fehler finden.
Läst sich die Datei sonst normal öffnen?
Gruß
JöKe
Antwort 4 von Anno2005
Moin
Ja ,sonst läßt sich die csv – Datei ohne weiteres öffnen!
Ich hab noch ein bisschen herum probiert und auch eine Lösung
gefunden .Mit .Filename = ".csv" hat es dann geklappt.
Die Suche geht damit auch noch schneller ,weil ich nur wenige
csv – Dateien gespeichert habe.
Sub Wareneingang_öffnen()
Dim zähler As Long, Datei As String, Meldung As String
Application.ScreenUpdating = False
Datei = "Wareneingang.csv"
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = "C:\"
.Filename = ".csv"
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
Meldung = MsgBox("Die Datei "" Wareneingang.csv"" " & _
"wurde auf Laufwerk ""C"" nicht gefunden!" & Chr(13) & _
"Bitte die Datei erstellen! (Großschreibung)", vbOKOnly)
Exit Sub
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Vielen Dank nochmal für deine eifrige Mühe!
Bis zum nächsten Problem
Tschüss
Ja ,sonst läßt sich die csv – Datei ohne weiteres öffnen!
Ich hab noch ein bisschen herum probiert und auch eine Lösung
gefunden .Mit .Filename = ".csv" hat es dann geklappt.
Die Suche geht damit auch noch schneller ,weil ich nur wenige
csv – Dateien gespeichert habe.
Sub Wareneingang_öffnen()
Dim zähler As Long, Datei As String, Meldung As String
Application.ScreenUpdating = False
Datei = "Wareneingang.csv"
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = "C:\"
.Filename = ".csv"
If .Execute <> 0 Then
zähler = 1
Do
If Right(.FoundFiles.Item(zähler), Len(Datei)) = Datei Then
Workbooks.Open Filename:=.FoundFiles.Item(zähler)
Exit Do
End If
zähler = zähler + 1
If zähler > .FoundFiles.Count Then
Meldung = MsgBox("Die Datei "" Wareneingang.csv"" " & _
"wurde auf Laufwerk ""C"" nicht gefunden!" & Chr(13) & _
"Bitte die Datei erstellen! (Großschreibung)", vbOKOnly)
Exit Sub
End If
Loop While zähler <= .FoundFiles.Count
End If
End With
End Sub
Vielen Dank nochmal für deine eifrige Mühe!
Bis zum nächsten Problem
Tschüss

