GetOpenFilename

23/02/2010 - 20:57 von Philipp | Report spam
Hallo Zusammen,

Ich verwende Excel 2002 und habe ein Problem mit der GetOpenFilename
Anwendung.

Mit dem nachfolgenden Code ermittel ich die Dateinamen mehrerer Dateien und
schreibe diese in ein Worksheet um damit spàter weiterzuarbeiten.
Das Problem ist dass es nur manchmal funktioniert. Auf meinem Rechner
funktioniert es meistens aber auch nicht immer und auf dem Rechner des
Kollegens fast nie.

Wenn ich den Code in Einzelschritten ausführe dann klappt es meistens auch
nicht, lasse ich ihn voll durchlaufen funktioniert es wieder öfters. Bei
Einzelschritten bekomme ich auch einen Fehler "Filename(iCounter) Index
außerhalb des gültigen Bereichs. Da habe ich dass Gefühl, dass dann gar
keine Werte in mein Array "var" geschrieben werden.

Kann ich an meinem Code etwas verbessern oder gibt es vielleicht noch eine
andere Lösung die Dateinamen benutzerfreundlich mit dem Explorer Fenster
auszulesen?

Danke für Eure Tips,
Philipp



Dim var() As Variant
Dim iCounter As Long

ChDrive ThisWorkbook.Path 'Explorer startet im Pfad der Masterdatei
ChDir ThisWorkbook.Path 'Explorer startet im Pfad der Masterdatei
var = Application.GetOpenFilename(, , "Auswahl einzulesende Dateien", ,
True)

For iCounter = 1 To UBound(var)
Master.Sheets("Daten importieren").Activate
ActiveCell.Value = var(iCounter)
ActiveCell.Offset(1, 0).Select
Next iCounter
 

Lesen sie die antworten

#1 Andreas Killer
24/02/2010 - 09:13 | Warnen spam
On 23 Feb., 20:57, "Philipp" wrote:

andere L sung die Dateinamen benutzerfreundlich mit dem Explorer Fenster
auszulesen?


Jupp, ich hàtte da eine.

Andreas.

Sub Test()
Dim Dateien() As String, I As Long, Y As Long
I = GetOpenFileNameA(Dateien, , "*.xls|*.*", "Excel-" & _
"Dateien|Alle Dateien")
If I = 0 Then Exit Sub
For I = LBound(Dateien) To UBound(Dateien)
Y = Y + 1
Cells(Y, 1) = Dateien(I)
Next
End Sub

Private Function GetOpenFileNamePrim( _
ByRef FileArray As Variant, ByVal Multi As Boolean, _
Optional ByVal Pfad As String = "", Optional ByVal Maske _
As String = "", Optional ByVal FileTyp As String = "", _
Optional ByVal Titel As String) As Long
'Zeigt das Dialogfeld "Öffnen" und liefert den ausgewàhlten _
Dateinamen
'Mehrere FileTypen, bzw. Masken können durch | getrennt _
angeben werden
'Beispiel: Maske:= "*.zip;*.arj|*.txt", FileTyp:= _
"Archive|Textdateien"
Dim SavePfad As String, FileFilter As String, FileToOpen As _
Variant, DoRedim As Boolean
Dim FData() As String, SData() As String, I As Long, J As Long

'Aktuellen Pfad sichern
SavePfad = CurDir
'Ggf. auf Laufwerk, Pfad wechseln
If Len(Pfad) > 0 Then
On Error GoTo Exitpoint
If InStr(Pfad, ":") > 0 Then ChDrive Pfad
ChDir Pfad
On Error GoTo 0
End If

'Mehrfache Angaben aufsplitten
FData = Split(FileTyp & "|", "|")
SData = Split(Maske & "|", "|")
'Sicherstellen das die Datenfelder gleich groß sind
If UBound(FData) > UBound(SData) Then ReDim Preserve SData( _
LBound(SData) To UBound(FData)) As String
If UBound(SData) > UBound(FData) Then ReDim Preserve FData( _
LBound(FData) To UBound(SData)) As String

'Den Filefilter zusammensetzen
FileFilter = ""
For I = LBound(FData) To UBound(FData)
If Len(FData(I) & SData(I)) > 0 Then
FileFilter = FileFilter & FData(I)
If Len(FData(I)) > 0 Then FileFilter = FileFilter & " "
FileFilter = FileFilter & "(" & SData(I) & ")," & SData( _
I) & ","
End If
Next
If Len(FileFilter) > 0 Then FileFilter = Mid(FileFilter, 1, _
Len(FileFilter) - 1)

'Datei(en) auswàhlen
FileToOpen = Application.GetOpenFileName(FileFilter, Title:= _
Titel, MultiSelect:=Multi)

'Was wurde selektiert?
GetOpenFileNamePrim = 0
Select Case VarType(FileToOpen)
Case vbBoolean
'Keine Datei, Abbruch
GoTo Exitpoint
Case vbString
'Einzelne Datei
FileArray = FileToOpen
GetOpenFileNamePrim = 1
Case Else
'Mehrere Dateien
On Error Resume Next
'Hat das array genug Platz?
DoRedim = UBound(FileToOpen) - LBound(FileToOpen) > _
UBound(FileArray) - LBound(FileArray)
If Err <> 0 Then
'Nein, array ist nicht dimensioniert
DoRedim = True
Err.Clear
End If
If DoRedim Then
ReDim FileArray(0 To UBound(FileToOpen) - LBound( _
FileToOpen)) As String
If Err <> 0 Then
'Array ist vordimensioniert und zu klein
GoTo Exitpoint
End If
End If
On Error GoTo 0
'Dateinamen übertragen
J = LBound(FileArray)
For I = LBound(FileToOpen) To UBound(FileToOpen)
FileArray(J) = FileToOpen(I)
J = J + 1
Next
GetOpenFileNamePrim = UBound(FileToOpen) - LBound( _
FileToOpen) + 1
'Ggf. restliche Plàtze löschen
For I = J To UBound(FileArray)
FileArray(I) = ""
Next
End Select

Exitpoint:
On Error GoTo 0
ChDrive SavePfad
ChDir SavePfad
End Function

Function GetOpenFileName(ByRef FileToOpen As String, _
Optional ByVal Pfad As String = "", Optional ByVal Maske _
As String = "", Optional ByVal FileTyp As String = "", _
Optional ByVal Titel As String = "") As Boolean
'Zeigt das Dialogfeld "Öffnen", Liefert True wenn eine Datei _
ausgewàhlt wurde und den Namen in FileToOpen
'mehrere FileTypen, bzw. Masken können durch | getrennt _
angeben werden
'Beispiel: Maske:= "*.zip;*.arj|*.txt", FileTyp:= _
"Archive|Textdateien"
GetOpenFileName = GetOpenFileNamePrim(FileToOpen, False, _
Pfad, Maske, FileTyp, Titel) > 0
End Function

Function GetOpenFileNameA(ByRef FilesToOpen() As String, _
Optional ByVal Pfad As String = "", Optional ByVal Maske _
As String = "", Optional ByVal FileTyp As String = "", _
Optional ByVal Titel As String = "") As Long
'Zeigt das Dialogfeld "Öffnen", Liefert die Anzahl _
ausgewàhlter Dateien und die Namen in FilesToOpen
'mehrere FileTypen, bzw. Masken können durch | getrennt _
angeben werden
'Beispiel: Maske:= "*.zip;*.arj|*.txt", FileTyp:= _
"Archive|Textdateien"
GetOpenFileNameA = GetOpenFileNamePrim(FilesToOpen, True, _
Pfad, Maske, FileTyp, Titel)
End Function

Ähnliche fragen