Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1460to1464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

freie Auswahl eines zu bearbeitenden Ordners

freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 13:20:41
Peter
Hallo Leute,
ich hab nochmal eine Frage bzw. ein Problem:
Ich würde gernen einen ganzen Ordner in Excel einlesen. Hierzu gebe ich einen bestimmten Pfad an. Nun würde ich es gerne so umsetzen, dass andere User einen beliebigen Ordner auswählen können, der dann ausgewertet wird. Die Auswertung funktioniert soweit perfekt. Das einlesen unter meinem Accout auch. Da ich einen festen Pfad angebe.
Hier mal mein Code:
' Import_Ordner
' -- Verzeichnisauswahl
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\" 'Startverzeichnis
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl des auzuwertenden Ordners"
.InitialFileName = Environ("USERPROFILE")
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1)
If Right(strPath, 1) "\" Then strPath = strPath & "\"
End If
End With
If Len(strPath) Then
' importieren eines ganzen Ordners
Dim strPfad As String
Dim FSO As Object
Dim file
Dim lngLR As Long
'********************************
'Anpassen an den Ort wo Dateien abgelegt
strPfad = "C:\"
'********************************
Set FSO = CreateObject("scripting.filesystemobject")
For Each file In FSO.getfolder(strPfad).Files
strFileName = file.Name
strDestination = "A" & Cells(Rows.Count, 1).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strPfad & strFileName, Destination:=Range( _
strDestination))
.Name = "Auswertung-Datenlogging"
.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(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
In der dick markierten Zeile habe ich normal den Pfad zu dem Ordner. Weiß evtl. jemand wie ich das hinkriege?
Vielen Dank Peter :)

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 14:11:39
UweD
Hallo
du Überschreibst den Startordner mehrfach..
Sub Import_Ordner()
' -- Verzeichnisauswahl
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "c:\Temp" 'Startverzeichnis'****Hier legst du den Startordner fest
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl des auzuwertenden Ordners"
.InitialFileName = Environ("USERPROFILE")'****Hier überschreibst du ihn wieder !!!Zeile  _
kann weg
.InitialView = msoFileDialogViewList
If .Show = -1 Then'****Hier erfolgt die Auswahl Userauswahl
strPath = .SelectedItems(1)
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
End If
End With
If Len(strPath) Then
' importieren eines ganzen Ordners
Dim strPfad As String
Dim FSO As Object
Dim file
Dim lngLR As Long
'Anpassen an den Ort wo Dateien abgelegt
strPfad = "C:\"'***********Hier setz du den Startordner wieder !!! Zeile kann weg
Beide markierten Zeilen können weg
Gruß UweD

Anzeige
AW: freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 14:23:38
UweD
Uuuuppps
Hab gerade noch gesehen, dass du ja Pfad und Path verwendest.
Da muss ich nochmal ran...

AW: freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 14:34:35
UweD
Hi
so, im unteren Teil das Pfad durch Path ersetzen...
Hier der ganze Code
Sub Import_Ordner()
' -- Verzeichnisauswahl
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\" 'Startverzeichnis' wichtig mit \am Ende
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl des auzuwertenden Ordners"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1)
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
End If
End With
If Len(strPath) Then
' importieren eines ganzen Ordners
Dim FSO As Object
Dim file
Dim lngLR As Long
Set FSO = CreateObject("scripting.filesystemobject")
For Each file In FSO.getfolder(strPath).Files
strFileName = file.Name
strDestination = "A" & Cells(Rows.Count, 1).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strPfad & strFileName, Destination:=Range( _
strDestination))
.Name = "Auswertung-Datenlogging"
.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(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,  _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,  _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
End If
End Sub

Anzeige
AW: freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 14:38:44
UweD
und noch einen vergessen..
:-(
"TEXT;" & strPath & strFileName, Destination:=Range( _

AW: freie Auswahl eines zu bearbeitenden Ordners
10.12.2015 14:50:03
Peter
Wow ok super danke :) muss ich gleich testen

AW: freie Auswahl eines zu bearbeitenden Ordners
15.12.2015 11:10:35
UweD

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige