Datei öffnen (Erweiterung)

Forumthread: Datei öffnen (Erweiterung)

02.11.2004 15:40:30

Niels

Hallo Exel-Helfer,
der Sepp hat mir vor einigen Wochen schon mal mit folgendem Code geholfen:
(Vielen Dank Sepp!!! www.herber.de/forum/archiv/504to5087/t505737.htm#505737)


Sub Oeffnen()
Dim strName As String
Dim fs As Object
strName = "D:\Temp\" & Format(ActiveSheet.Range("A1"), "ddmmyyyy") & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists(strName) Then
Workbooks.Open (strName)
Else
strName = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If strName = False Then Exit Sub
Workbooks.Open (strName)
End If
End Sub

Der Makro öffnet eine Datei, die unter einem Datum abgelegt wurde. (TTMMJJJJ.xls)
Wenn die Datei nicht gefunden wird, kann manuell danach gesucht werden.
Jetzt meine neue Frage...
Wenn die richtige Datei (z.B. vom 25.11.04 also 25112004.xls) nicht gefunden wird, möchte ich, dass der Makro automatisch die nächstmögliche Tabelle öffnet.
Dass heißt, die nächstgelegene, nach oben oder nach unten (z.B. sind 12112004.xls und 01122004.xls verfügbar -> Makro soll in diesem Fall 01122004.xls öffnen, weil -> dichter dran)
Eine MSGBOX soll dann darauf hinweisen, dass die Datei vom TT.MM.JJJJ nicht gefunden wurde und die Datei vom TT.MM.JJJJ geöffnet wurde
Ist so was lösbar?
Viele Grüße und vielen Dank für die Hilfe
Niels

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datei öffnen (Erweiterung)

Sven

Nein, nicht möglich, glaube ich.
mfg Sven

Hat keiner eine Idee?

02.11.2004 19:26:03

Niels

mm?! ;o(
Fällt denn keinem was ein?
Ich dachte da an einen Vergleich der Tage zwischen > und > und bzw. >.
In Excel wäre es über "wenn-dann" recht einfach umzusetzen, aber in VBA habe ich leider keinen Plan. ;o(
Vielen Dank für Eure Bemühungen
Niels

AW: Hat keiner eine Idee?

Reinhard

hi Niels,
ungetestet, deshalb Frage noch offen:


Sub Oeffnen()
Dim strName As String
Dim fs As Object
strName = "D:\Temp\" & Format(ActiveSheet.Range("A1"), "ddmmyyyy") & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.fileexists(strName) Then
With Application.FileSearch
.NewSearch
.LookIn = "d:\temp"
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
strName2 = .FoundFiles(1)
For i = 2 To .FoundFiles.Count
If DateDiff("d", DatExtrakt(strName2), DatExtrakt(.FoundFiles(i))) _
< DateDiff("d", DatExtrakt(strName), DatExtrakt(.FoundFiles(i))) Then _
strName = strName2
Next i
Else
Exit Sub
End If
End With
End If
Workbooks.Open (strName)
End Sub
Function DatExtrakt(PfadDatei As String) As Date
intPos = InStrRev(PfadDatei, "\")
strDatum = Mid(PfadDatei, pos + 1, 8)
DatExtrakt = DateSerial(Mid(strDatum, 5, 4), Mid(strDatum, 3, 2), Mid(strDatum, 1, 2))
End Function

Gruß
Reinhard

Fehlermeldung

03.11.2004 10:49:39

Niels

Hallo Reinhard,
danke für Deine Antwort.
Ich habe den Code in einer neuen Tabelle getestet.
Habe zwei Test-Dateien zum öffnen erstellt und im Code nur den Pfad verändert.
Ich bekomme in folgender Zeile eine Fehlermeldung:
Fehler: Compile error ByRef argument type mismatch
Zeile: If DateDiff("d", DatExtrakt(strName2), DatExtrakt(.FoundFiles(i)))
strName2 - wird bei dem Fehler markiert.
Hast Du / Jemand eine Idee?
Kann das mit dem Pfad zusammenhängen?
Viele Grüße aus Köle
Niels

AW: Fehlermeldung

Reinhard

Hi Niels,
wechsle mal den Funktionskopf in:
Function DatExtrakt(ByVal PfadDatei As String) As Date
Gruß
Reinhard

Run time error

03.11.2004 18:30:27

Niels

Hallo Reinhard,
vielen Dank für Deine Geduld!!! ;o)
Habe die Änderung vorgenommen aber offenbar gibts da ein Problem in der Function.
Kriege einen Run time error 13 - Type mismatch in der Zeile:
DatExtrakt = DateSerial(Mid(strDatum, 5, 4), Mid(strDatum, 3, 2), Mid(strDatum, 1, 2))
Viele Grüße
Niels

AW: Run time error

Reinhard

Hallo Niels,
ja, war noch ein Fehler drin:


Function DatExtrakt(PfadDatei As String) As Date
intPos = InStrRev(PfadDatei, "\")
strDatum = Mid(PfadDatei, intPos + 1, 8)
DatExtrakt = DateSerial(Mid(strDatum, 5, 4), Mid(strDatum, 3, 2), Mid(strDatum, 1, 2))
End Function

Gruß
Reinhard

...wieder der alte Fehler ;o(

04.11.2004 13:11:50

Niels

Hallo Reinhard,
ich hoffe, Du gibst nicht auf! ;o)
... das war ja schon die erste Variante der Function.
Da bekomme ich wieder die Fehlermeldung:
Fehler: Compile error ByRef argument type mismatch
Zeile: If DateDiff("d", DatExtrakt(strName2), DatExtrakt(.FoundFiles(i)))
strName2 - wird bei dem Fehler markiert.
Ich habe mal meine Test-Datei hochgeladen:
https://www.herber.de/bbs/user/12972.xls
Viele Grüße
Niels

AW: ...wieder der alte Fehler ;o(

Reinhard

Hi Niels,
nein, in der Function wurde was geändert, pos zu intPos.
Probiere es mal mit der geänderten Version.
Gruß
Reinhard

Beliebteste Forumthreads (12 Monate)

Forumthread: Datei öffnen (Erweiterung)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread