PDA

Vollständige Version anzeigen : Dateien aus Ordner öffnen


MHC2004
20.02.2008, 09:30
Hallochen,

hab wieder ein Problem und komme nicht auf den richtigen Gedanken.
Folgenden Code habe ich einem Button zugefügt:

Private Sub CommandButton3_Click()
Dim Fld As Object
Dim foldername As String
Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder", 512)
If Not Fld Is Nothing Then
foldername = Fld.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If
End If
Me.OrdnerPfad.Caption = foldername
End Sub


Funktioniert super.Ordnerpfad wird auch im Label angezeigt.

Folgender Code ist in einem Modul:

Sub OpenWkb()
Dim rng As Range

Dim iCounter As Integer, nRow As Integer
Dim oWs As Worksheet
Dim A As String, sPath As String, sfile As String
Dim anz, aa
Dim Fld As Object
Dim foldername As String

anz = 0
' Öffnet alle Dateien in einem angegebenen Verzeichnis mit der vorgegeben Endung

' Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
sPath = "D:\Auswertungen\"
A = Dir(sPath & "\*.csv", 7)
Do
aa = VBA.Strings.Left(A, Len(A) - 4)
Sheets.Add.Name = aa 'Tabellenblatt erstellen mit den entsprechenden Namen
anz = anz + 1

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & A _
, Destination:=Range("A1"))
.Name = aa
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 2, 1, 1, 1, 1, 1, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With


Ich möchte nun nicht jede Datei im Ordner mit dem Modulcode öffnen sondern über den Dialog "Ordner öffnen" der im Button hinterlegt ist.

Wie muß das Modul angepasst werden das dies funktioniert?

Kann mir dabei jemand helfen?
Evtl. nur ne Hilfestellung.Fertigen Code möcht ich nicht.Wills ja lernen!:D

Grüße

jinx
20.02.2008, 09:39
<font size="2" face="Century Gothic">Moin, MHC2004,

Application.Run "Tabelle1.CommandButton3_Click"
Codenamen der Tabelle anpassen...</font>

MHC2004
20.02.2008, 10:38
...da haben wir es wieder.
War ich wohl ein bischen voreilig.

Kannst du es mir näher bringen?:p

jinx
20.02.2008, 11:20
<font size="2" face="Century Gothic">Moin, MHC2004,

das Problem liegt darin, dass in Deinem Code für die Schaltfläche eine Beschriftung verändert wird - und Du für den Code die Rückgabe eines Strings benötigst oder aber die Caption in der UserForm auslesen musst.

Die Aufteilung könnte wie folgt aussehen:

'Schaltfläche
Private Sub CommandButton3_Click()
Me.Ordnerpfad.Caption = Aufruf_BrowseForFolder
End Sub
'Funktion - Standardmodul
Function Aufruf_BrowseForFolder() As String
Dim Fld As Object
Dim foldername As String
Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder", 512)
If Not Fld Is Nothing Then
Aufruf_BrowseForFolder = Fld.Self.Path
If Right(Aufruf_BrowseForFolder, 1) <> "\" Then
Aufruf_BrowseForFolder = Aufruf_BrowseForFolder & "\"
End If
End If
End Function
Und die Funktion sollte ohne Probleme auch aus einer anderen Prozedur heraus aufgerufen werden können:

sPath = Aufruf_BrowseForFolder</font>

MHC2004
20.02.2008, 12:19
Habe es so gemacht:

Private Sub CommandButton3_Click()
Dim Fld As Object
Dim foldername As String
Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder", 512)
If Not Fld Is Nothing Then
Aufruf_BrowseForFolder = Fld.Self.Path
If Right(Aufruf_BrowseForFolder, 1) <> "\" Then
Aufruf_BrowseForFolder = Aufruf_BrowseForFolder & "\"
End If
End If
Me.OrdnerPfad.Caption = Aufruf_BrowseForFolder

End Sub

und im Modul:

Sub OpenWkb()
Dim rng As Range
Dim iCounter As Integer, nRow As Integer
Dim oWs As Worksheet
Dim A As String, sPath As String, sfile As String
Dim anz, aa
anz = 0
' Öffnet alle Dateien in einem angegebenen Verzeichnis mit der vorgegeben Endung

' Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
sPath = UserForm1.OrdnerPfad.Caption <------eingebunden richtig?
A = Dir(sPath & "*.csv", 7)
Do
aa = VBA.Strings.Left(A, Len(A) - 4)
Sheets.Add.Name = aa 'Tabellenblatt erstellen mit den entsprechenden Namen
anz = anz + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;*********" & A, Destination:=Range( _<------hier fehlt glaub ich was denn Orginal stand dort der Pfad
"A1"))
.Name = aa
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 2, 1, 1, 1, 1, 1, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Doch leider bekomme ich immer einen Fehler.
Die Textdatei kann nicht gefunden werden.
Ich weiß das oben wo die Sterne sind ein Bezug zur Datei oder zum Ordner fehlt aber ich weiß nicht wie.
Ordner Auswahl funktioniert.

Woran liegt das?Was fehlt dem Code?

MHC2004
20.02.2008, 13:12
ha...:)

hab es rausgefunden und es funktioniert.
Der Pfadbezug darf nicht in den Anführungszeichen stehen, sondern danach.

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPath & A, Destination:=Range( _
"A1"))

Trotzdem vielen Dank, Jinx.



Grüße