Import csv Datei mit Makro auf Mac Office 2019
29.04.2019 15:32:43
Dani
Ich bemühe mich gerade um einen csv Import mittels Makro. Den Code am Ende habe ich mittels dem _ Makro Aufzeichner ermittelt. Soweit funktioniert dieser auch. Das Problem ist nun aber, dass die Datei nicht immer am gleichen Ort ist. Das "TEXT;/Vol..." muss also einer variablen Lösung weichen. Hier gerate ich aber ins Stocken. Ich habe schon einiges ausprobiert, was ich online gefunden habe. Eine Möglichkeit ist der nachfolgende Cod. Leider erhalte ich dabei einen Laufzeitfehler bei folgender Zeile:
.Refresh BackgroundQuery:=False
Sub test()
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim fname As String
Dim mybook As Workbook
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:YourUserName:Desktop:TestFolder:"
MyScript = "set applescript's text item delimiters to (ASCII character 10) " & vbNewLine & _
"set theFiles to (choose file of type " & _
" (""public.comma-separated-values-text"") " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, Chr(10))
For N = LBound(MySplit) To UBound(MySplit)
'Get file name only and test if it is open
fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), _
Application.PathSeparator, , 1))
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MySplit(N))
On Error GoTo 0
Next
End If
Application.CutCopyMode = True
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("$A$1"))
.Name = "CSV" & Worksheets.Count + 1
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A5").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Columns("H:K").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut Destination:=Columns("H:H")
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:G").Select
Selection.ColumnWidth = 10
Range("A1").Select
End Sub
Hier noch der Code, welchen ich aus dem Recorder erhalten habe.
Sub Makro1()
' Makro1 Makro
Application.CutCopyMode = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Volumes/NO NAME/****.CSV", Destination:=Range("$A$1"))
.Name = "*****"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A5").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("C:E").Select
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Columns("H:K").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut Destination:=Columns("H:H")
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:G").Select
Selection.ColumnWidth = 10
Range("A1").Select
End Sub
Könnt ihr mir hier bitte ein wenig unter die Arme greifen? Eingesetzt ist das Mac Office 2019 mit iOS Sierra 10.12.6.
Schon im voraus herzlichen Dank für eure Zeit.
Gruss
Dani