csv aus ordner importieren (pfad ist variabel)
27.05.2025 10:53:14
Klaus
ich steh mal wieder auf dem Schlauch. Ich habe ein Makro um eine CSV-Datei als query zu importieren. Mit statischen Angaben funktioniert das auch sehr gut. In der Praxis ist der Pfad aber variabel, muss also erst gesucht und zusammengebaut werden. Leider schaff ich das nicht und brauche hier eure Hilfe.
Die csv-Datei "ABC_result.csv" existiert in ganz vielen Unter-Ordnern. Um die genaue zu finden, muss der User am Anfang des Makros einen Wert eingeben, dann ist der Pfad eindeutig. Der eindeutige Unter-Ordner muss aber gesucht werden, steht auch leider an unterschiedlichen Stellen, d.h. der Pfad ist variabel. Das Makro soll nun nach Eingabe der Nummer den Pfad zusammen bauen und die csv-Datei einlesen. Es gibt einen Basis-Pfad \\ABC\user_xyz\abc\ und ab hier dann die Unter-Ordner, z.b. \\ABC\user_xyz\abc\def\1234\AAA_results.csv oder auch \\ABC\user_xyz\abc\def\1234\ghi\AAA_results.csv
Ich hoffe mir kann geholfen werden.
Gruß Klaus
Hier mal mein statisches Makro
Public Sub AAA()
Dim i As Long
Dim search_dut As Range
Dim search_partname As Range
Dim screw_ident As String
Dim Q
Number = InputBox("which number do you want to import?", "number")
For Each Q In ActiveWorkbook.Queries
If Q.Name = "AAA_results" Then Q.Delete
Next
ActiveWorkbook.Queries.Add Name:="topcover_results", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Csv.Document(File.Contents(""\\ABC\user_xyz\abc\def\1234\AAA_results.csv""),[Delimiter="";"", Columns=27, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumn" & _
"Types(#""Promoted Headers"",{{""Ergebnis-ID"", Int64.Type}, {""Kurve verfügbar"", type text}, {""Sitzung"", type datetime}, {""Testparameter ID"", Int64.Type}, {""Name"", type text}, {""Testtyp"", type text}, {""Werkzeugtyp"", type text}, {""Verbundene Geräte"", type text}, {""Datum/Zeit"", type datetime}, {""Status"", type text}, {""Einheit"", type text}, {""Drehmo" & _
"ment"", Int64.Type}, {""Nominal Drehmoment"", Int64.Type}, {""Winkelschwellwert"", Int64.Type}, {""Min Drehmoment"", Int64.Type}, {""Max Drehmoment"", Int64.Type}, {""Winkel"", Int64.Type}, {""Spitzenwert Drehmoment"", Int64.Type}, {""Winkel bei Spitzenwert Drehmoment"", Int64.Type}, {""Drehmoment max. Winkel"", Int64.Type}, {""Max. Winkel"", Int64.Type}, {""Nominal" & _
" Winkel"", Int64.Type}, {""Min. Winkel"", Int64.Type}, {""Max. Winkel_1"", Int64.Type}, {""VIN"", type text}, {""Seq. Ergebnis"", Int64.Type}, {""Hinweis Kurve"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=AAA_results;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [AAA_results]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "AAA_results"
.Refresh BackgroundQuery:=False
End With
ActiveWorkbook.Queries("AAA_results").Delete
ActiveSheet.Name = "AAA_results"
For i = 1 To Cells(Rows.Count, 12).End(xlUp).Row
If IsNumeric(Range("L" & i)) Then
Range("L" & i) = Range("L" & i) / 100
End If
Next
screw_ident = "AAA"
Range("AAA_results[Drehmoment]").Select
Selection.Copy
Sheets("screws").Select
Set search_dut = ActiveSheet.Rows(1).Find(What:=DUT, Lookat:=xlWhole)
Set search_partname = ActiveSheet.Columns(5).Find(What:=screw_ident, Lookat:=xlWhole)
Intersect(search_partname.EntireRow, search_dut.EntireColumn).Offset(2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Teardown").Select
Set search_dut = ActiveSheet.Rows(1).Find(What:=DUT, Lookat:=xlWhole)
Set search_partname = ActiveSheet.Columns(5).Find(What:=screw_ident, Lookat:=xlWhole)
Intersect(search_partname.EntireRow, search_dut.EntireColumn).Offset(2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
Sheets("screws").Select
Range("B2").Select
Sheets("AAA_results").Delete
End SubAnzeige