|
Moin zusammen, ich habe ein Makro, wechles mir hilft CSV Dateien zu importieren, die in einer Zelle Zeilenumbrüche aufweisen. Ich muss am Tag mehrere CSV-Dateien öffnen und diese sind in unterschiedlichen Ordnern zu finden und auch unterschiedlich benannt. Der Name des Ordners findet sich aber auch immer im Dateinamen wieder.
Ich möchte gerne, ohne diesen Wert im Makro durch Suchen und Ersetzen immer anzupassen, dieses Makro verwenden. Im Idealfall muss ich diesen Wert nur einmal eingeben und das Makro starten (ähnlich wie die Declare Funktion bei mssql).
In diesem Makro z.B. ist der Wer L456789 und ich möchte diesen gerne variabel halten und z.B. auf B6543 ändern und dannauf W9032.
Suchen udn ersetzen hilft, aber auch nur bedingt, da ich diesen Arbeitschschritt gerne vermeiden würde.
Evtl. hat hier ja jemand eine Idee bzw. lösung dafür.
Sub CSV_importieren()
Dim ArrDaten
'CSV-Datei komplett in den Arbeitsspeicher laden und dabei aufteilen in einzelne Zeilen
Open "X:\Import\B1420\Aktuelle-CSV\L456789-Aktuell.csv" For Input As #1
ArrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
'Alle vbLF in alle Zeilen ersetzen durch eine offene, eckige Klammer {
For Zeile = 0 To UBound(ArrDaten)
ArrDaten(Zeile) = Replace(ArrDaten(Zeile), Chr(13), Chr(123))
Next Zeile
'Geänderte CSV-Datei in einer TMP-Datei speichern
Open "X:\Import\L456789\Aktuelle-CSV\L456789-Aktuell.tmp" For Output As #1
For Zeile = 0 To UBound(ArrDaten)
Print #1, ArrDaten(Zeile)
Next Zeile
Close #1
'Neue Arbeitsmappe erstellen
Workbooks.Add (xlWBATWorksheet)
Dim ws As Worksheet
Set ws = ActiveSheet
'Eine Sekunde warten, damit das Worksheet erstellt ist, sonst bringt die QueryAbfrage einen Fehler
Application.Wait (Now + TimeValue("0:00:01"))
Dim connectionName As String
connectionName = "TEXT;X:\Import\L456789\Aktuelle-CSV\L456789-Aktuell.tmp"
With ws.QueryTables.Add(Connection:=connectionName, Destination:=ws.Range("A1"))
.Name = DName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierSingleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.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, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'In allen Zellen die offene, eckige Klammer { durch einen Zeilenumbruch vbLF ersetzen
Cells.Replace What:=Chr(123), Replacement:=vbLf, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'TEMP-Datei löschen
Set FS = CreateObject("Scripting.FileSystemObject")
Set f = FS.GetFile("X:\Import\L456789\Aktuelle-CSV\L456789-Aktuell.tmp")
f.Delete
End Sub
|