Supportnet Computer
Planet of Tech

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

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?

Antwort 3 von JoeKe

Moin Anno,

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: