Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1864to1868
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

csv anstelle xlsx

csv anstelle xlsx
25.01.2022 13:39:01
Daniela
Hallo zusammen,
Ich komme mit dem Einlese Makro immer noch nicht weiter.
Nun werden mir anstelle von Excel Dateien, csv Dateien geschickt. Lese ich die CSV Datei ein, wird in den Zellen #Bezug! dargestellt.
Was muss ich in dem Makro alles umstellen, damit anstelle von XLSX, CSV erkannt wird?
Wer ist so lieb und kann mir einen Tipp geben?

Sub Einlesen ()
ActiveSheet.Unprotect Password:="*****"
Dim oMe As Worksheet, iZeile As Long, oDatei As Object
Dim oFS As Object, wbQuelle As Workbook, sBlatt As String
Set oMe = ThisWorkbook.ActiveSheet
Const sDateiPfad As String = "…… \"
iZeile = 2
Application.ScreenUpdating = False
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
If InStrRev(oDatei.Name, "xlsx") Then
sBlatt = "Tabelle1"
oMe.Cells(5, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("A2"))
oMe.Cells(4, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("B2"))
oMe.Cells(3, 7) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C2"))
oMe.Cells(12, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("D2"))
oMe.Cells(13, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("E2"))
iZeile = iZeile + 1
End If
Next
Set oMe = Nothing: Set wbQuelle = Nothing
ActiveSheet.Protect Password:="*****"
End Sub
Private Function GetValue(ByVal sPath As String, ByVal sFile As String, _
ByVal sSheet As String, oTarget As Object) As Variant
' Einen Wert aus einer Datei holen
On Error GoTo ErrorHandler
If Right$(sPath, 1)  "\" Then sPath = sPath & "\"
GetValue = ExecuteExcel4Macro("'" & sPath & "[" & sFile & "]" & sSheet & "'!" _
& oTarget.Range("A1").Address(, , xlR1C1))
On Error GoTo ErrorHandler
If IsError(GetValue) Then
GetValue = ExecuteExcel4Macro("'" & sPath & "[" & sFile & "]" & "Feuil1" & "'!" _
& oTarget.Range("A1").Address(, , xlR1C1))
End If
Exit Function
ErrorHandler:
GetValue = CVErr(xlErrRef)
End Function
lg Daniela

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: csv anstelle xlsx
25.01.2022 14:22:26
JoWE
Hallo Daniela,
zunächst müsste vermutlich (ungetestet) if InStrRev(oDatei.Name, "xlsx") nach If InStrRev(oDatei.Name, "csv") geändert werden.
Aber danach ergeben sich in Deinem Makro weitere Probleme, daher:
Schau Dir doch mal den Code von Rudi Rudi Maintaire an:
https://www.herber.de/forum/archiv/1236to1240/1239032_CSVImport_ueber_VBA.html#1239045
Vielleicht hilft Dir das weiter!?
Gruß
Jochen
AW: csv anstelle xlsx
25.01.2022 14:33:36
volti
Hallo Daniela,
hab eDeinen Code nicht in Gänze gelesen und würd das ganze Kontrukt bzgl. csv wahrscheinlich auch anders lösen aber unter Beibehaltung Deines Codes könnest Du die nachfolgende

Function einsetzen und den Aufruf enrsprechend anpassen.
Das sollte funktionieren:

Code:

[Cc]

Sub Test() oMe.Cells(5, 2) = GetValue(sDateiPfad, oDatei.Name, Range("A2")) oMe.Cells(4, 2) = GetValue(sDateiPfad, oDatei.Name, Range("B2")) End Sub Function GetValue(ByVal sPfad As String, ByVal sFile As String, oRng As Range) Dim sArr() As String Dim iFF As Integer sFile = Replace(sPfad & "&bsol;" & sFile, "&bsol;&bsol;", "&bsol;") If Dir$(sFile) <> "" Then ' Ist Datei vorhanden? iFF = FreeFile Open sFile For Input As iFF ' Datei öffnen sArr = Split(Input(LOF(iFF), iFF), vbCrLf) ' Daten in Array einlesen Close iFF ' Datei schließen On Error Resume Next GetValue = Split(sArr(oRng.Row - 1), ";")(oRng.Column - 1) End If End Function

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: csv anstelle xlsx
25.01.2022 15:18:29
Daniela
Hallo Karl-Heinz
Vielen Dank für deine Hilfe.
Ich habe deine Lösung angepasst. Fehlermeldung wird nicht angezeigt, aber es werden auch keine Daten eingelesen.
Muss ich noch

sBlatt = Tabelle1
anpassen?
lg Daniela
AW: csv anstelle xlsx
25.01.2022 15:59:59
Volti
Hast Du denn auch die Abfrage der Erweiterung von xlsx in csv geändert? Hatte ich vergessen zu erwähnen.
Bin grad nicht am PC und kann nicht gucken.
Gruß Karl-Heinz
AW: csv anstelle xlsx
27.01.2022 15:53:55
Daniela
Hallo Karl-Heinz
Sorry, dass ich mich erst jetzt melde. Ich hatte andauernd Meetings und konnte an meinem Problem nicht weiter arbeiten.
Zu deiner Frage, ja ich hatte von xlsx auf csv umgestellt.
lg Daniela
Anzeige
AW: csv anstelle xlsx
25.01.2022 15:22:06
Daniela
Danke Jochen
Das ist ein guter Hinweis. Ich habe das Makro mal installiert. Da wird aber nur die Zeile eingefügt, die in der CSV vorhanden ist. Dann kann ich aber gleich das csv beim Speichern als xlsx abspeichern.
Daher muss ich mit meiner Lösung etwas anfangen können.
Aber ich danke dir herzlich für deine Spontane Hilfe.
lg Daniela
AW: csv anstelle xlsx
25.01.2022 16:16:09
JoWE
Nun, ich kenne Deine CSV-Datei nicht und sehe auch nicht wie das gewünschte Ergebnis aussehen soll.
Gruß
Jochen
AW: csv anstelle xlsx
25.01.2022 14:36:53
volti
Hallo Daniela,
ich habe Deinen Code nicht in Gänze gelesen und würde das ganze Konstrukt bzgl. csv wahrscheinlich auch anders lösen, aber unter Beibehaltung Deines Codes könnest Du die nachfolgende Funktion einsetzen und den Aufruf entsprechend anpassen.
Das sollte funktionieren, probiere es mal aus:
Code:

[Cc]

Sub Test() oMe.Cells(5, 2) = GetValue(sDateiPfad, oDatei.Name, Range("A2")) oMe.Cells(4, 2) = GetValue(sDateiPfad, oDatei.Name, Range("B2")) End Sub Function GetValue(ByVal sPfad As String, ByVal sFile As String, oRng As Range) Dim sArr() As String Dim iFF As Integer sFile = Replace(sPfad & "&bsol;" & sFile, "&bsol;&bsol;", "&bsol;") If Dir$(sFile) <> "" Then ' Ist Datei vorhanden? iFF = FreeFile Open sFile For Input As iFF ' Datei öffnen sArr = Split(Input(LOF(iFF), iFF), vbCrLf) ' Daten in Array einlesen Close iFF ' Datei schließen On Error Resume Next GetValue = Split(sArr(oRng.Row - 1), ";")(oRng.Column - 1) End If End Function

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige