Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1688to1692
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

Import csv Datei mit Makro auf Mac Office 2019

Import csv Datei mit Makro auf Mac Office 2019
29.04.2019 15:32:43
Dani
Hallo zusammen
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
Wenn ich diese Zeile ausklammere (') funktioniert er, macht mir aber eine Arbeitsmappenverbindung zur oder mit der csv-Datei und das Tabellenblatt bleibt leer.
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Import csv Datei mit Makro auf Mac Office 2019
30.04.2019 09:50:35
fcs
Hallo Dani,
ich nehme an, dass du in folgender Zeile
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("$A$1"))

fname durch MySplit(N) ersetzen muss, hier muss der Dateiname inclusive Pfad(Verzeichnis) angegeben werden.
LG
Franz
AW: Import csv Datei mit Makro auf Mac Office 2019
30.04.2019 14:41:30
Dani
Hallo Franz
Danke für die Antwort. Leider erhalte ich bei dieser Änderung hier einen Laufzeitfehler 9.
Das mit dem "Dateiname inclusive Pfad(Verzeichnis)" verstehe ich nicht ganz. Denn ich habe ja eine Datei offen und folglich auch ein Tabellenblatt. Beim Importieren erstellt es mir sowiso ein neues Tabellenblatt in die ich die csv-Daten importieren möchte. Wenn dann die Datei eingefügt wurde werde ich diese Datei als .xlsx speicher, i.d.Regel im gleichen Ordner wie die csv-Datei. Das Speichern gehört nicht in das Makro. Priorität hat der Import.
Gruss
Dani
Anzeige
AW: Import csv Datei mit Makro auf Mac Office 2019
30.04.2019 23:17:45
fcs
Hallo Dani,
dein Makro öffnet ja die CSV-Datei -warum dann zusätzlich der Import? - und fügt dann in dieser Datei ein Blatt für den Import ein.
Sinnvoller wäre eine leere Arbeitsmappe anzulegen und in diese zu importieren.
Ich hab mal das von mir unter Windows getestete Makro angepasst bezüglich des Datei-Auswahldialogs für den Mac.
Zu vollständiger Pfad(verzeichnis):
Excel benötigt für die meisten Datei-Aktionen die Angabe von Verzeichnis und Dateiname. Nur wenn man im akuellen Verzeichnis oder bestimmten Standardverzeichnissen arbeitet kann man auf die Pfad-Angabe verzichten.
LG
Franz
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))
For Each mybook In Application.Workbooks
If LCase(mybook.Name) = LCase(fname) Then
MsgBox "CSV-Datei """ & fname & """  ist geöffnet. Makro wird beendet."
Exit Sub
End If
Next
fname = MySplit(N)
'neue Mappe mit einem leeren Tabellenblatt öffnen
Application.Workbooks.Add Template:=xlWBATWorksheet
GoTo Weiter01
Next
Weiter01:
Else
Exit Sub
End If
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, _
Destination:=ActiveSheet.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
'Verbindung der Abfrage in Datei wieder löschen
ActiveWorkbook.Connections(1).Delete
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
'Datei speichern
ActiveWorkbook.SaveAs Filename:= Replace(fname, ".csv", ".xlsx"), fileformat:=51, addtomru:= _
True
End Sub

Anzeige
AW: Import csv Datei mit Makro auf Mac Office 2019
01.05.2019 14:46:07
Dani
Hallo Franz
Danke für deine Antwort und Zeitinvestition. Leider ist auch hier ein Laufzeitfehler aufgetreten und zwar bei der Speicherung. Nun habe ich im www folgenden Code gefunden der meiner Vorstellung entspricht.
Sub Makro2()
' Makro für das Importieren einer CSV-Datei
FileFormat = "{""public.plain-text""}"
On Error Resume Next
MyPath = MacScript("return (path to desktop folder) as String")
MyScript = _
"set theFile to (choose file of type" & _
" " & FileFormat & " " & _
"with prompt ""Please select a file"" default location alias """ & _
MyPath & """ without multiple selections allowed) as string" & vbNewLine & _
"return posix path of theFile"
file = MacScript(MyScript)
On Error GoTo 0
If file  "" Then
Application.CutCopyMode = True
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & file, 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
End If
'Verbindung der Abfrage in Datei wieder löschen
ActiveWorkbook.Connections(1).Delete
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
Freundliche Grüsse
Dani
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige