Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1084to1088
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 über xldialog lesbar öffnen

CSV über xldialog lesbar öffnen
Jordan
Hallo Zusammen,
ich hab hier und auch schon über Google nach meinem Problem gesucht. Leider habe ich aber nichts gefunden.
Ich habe viele Kollegen, die immer wieder CVS Dateien öffnen müssen. Nun wollte ich die mit einem kurzen Makro unterstützen.
Im Normalfall, öffnen die Kollegen zurerst mal Excel und dann gehen Sie über "Öffnen" in den Ordner wo sich die Datei befindet. Nun vergessen die Kollegen immer wieder, das Sie unter DateiTyp umstellen müssen auf z. B. CVS oder "alle Dateien". Hierfür wollte ich den Kollegen einen kleinen öffnen Dialog schreiben, scheitere aber kläglich an einem Problem.
Entweder ich mache es über Application.GetOpenFilename: Dann aber öffnet mir Excel die CSV Datei so, dass der Großteil der Daten in Spalte 1 und ein kleiner Teil der Daten noch in Spalte 2 steht.
Oder
ich mache es über Application.Dialogs(xlDialogOpen).show: Dann jedoch wird Standarmäßig wieder keine CSV Datei angezeigt.
Es ist zum Mäuse melken! Ich bekomme weder das eine noch das andere hin.
Wichtig: Wenn die CSV Datei normal geöffnet wird, also über "Öffnen" oder über den Dialog, dann erscheint die Datei brav mit den Daten je in einer Spalte!
Hat einer von Euch eine Idee?
Danke für Eure Hilfe!

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
CSV öffnen
03.07.2009 20:39:02
Backowe
Hi,
ich öffne eine CSV-Datei immer so:
VBA-Code:
Sub CSVOeffnen()
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName <> False Then _
  Workbooks.OpenText DateiName, Comma:=True
End Sub
Gruß Jürgen
AW: CSV öffnen
Jordan

Danke Jürgen,
ich hab meinen PC grad ausgemacht und wollt mich auf die Couch schmeißen. Ich werds morgen spätestens übermorgen ausprobieren und mich dann melden.
Trotzdem danke im voraus!
Leider der gleiche Fehler
Jordan

Hallo Jürgen,
habs gerade versucht! Hier passiert mir der gleiche Fehler, den ich schon hatte. Die Auswahl steht zwar auf csv, jedoch wird die Datei nicht aufbereitet und es sind nur die ersten zwei Spalten mit allen Daten gefüllt!
Hast du noch eine Idee?
Welches Trennzeichen ...
Backowe

Hi Jordan,
... wird denn verwendet?
Gruß Jürgen
AW: Welches Trennzeichen ...
Jordan

Hi Jürgen,
das Semikolon. Hab ich aber schon umgestellt. Sprich ....Semicolon:=True.
Bringt aber das gleiche Ergebnis
vielleicht gehts hiermit...
Tino

Hallo,
habe hier auch mal was zusammengebaut.
Es wird nach der Datei, nach den Trennzeichen und ab welcher Zelle der Import beginnen soll.
kommt als Code in Modul1
Option Explicit 
                 
Function TxT_ReadAll(ByVal sFilename As String) As String 
Dim F As Integer 
Dim sInhalt As String 
 
  If Dir$(sFilename, vbNormal) <> "" Then 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
  End If 
   
  TxT_ReadAll = sInhalt 
End Function 
 
Sub ImportCSV() 
Dim strDel As String, strInhalt As String, strDatei As String 
Dim rngErste As Range 
Dim myAr, myArZeile, myArNum 
Dim A As Long, B As Long 
Dim iCalc As Integer 
 
'Abfrage Datei 
strDatei = Application.GetOpenFilename("CSV Files (*.csv), *.csv, Text File(*.txt),*.txt") 
If strDatei = CStr(False) Then GoTo Benutzerabbruch: 
 
'Abfrage für Trennzeichen 
AbfrageDelimiter: 
strDel = InputBox("Geben Sie das verwendete Trennzeichen der CSV Datei ein", "CSV- Delimeter?") 
If StrPtr(strDel) = 0 Then GoTo Benutzerabbruch: 
 
If strDel = "" Then 
 If MsgBox("Sie haben kein Delimiter eingegeben!" & vbCr & _
           "Wollen Sie den Vorgang wiederholen drücken Sie auf 'Wiederhohlen'" & vbCr & _
           "Wollen Sie den Vorgang abbrechen drücken auf 'Abbrechen'", vbRetryCancel, "Keine Trennzeichen") = vbRetry Then 
             GoTo AbfrageDelimiter: 
 Else 
  Exit Sub 
 End If 
End If 
 
'Abfrage erste Zelle 
On Error Resume Next 
Set rngErste = Application.InputBox("In welcher Zelle soll der Import beginnen?", "Zelle auswählen", Selection(1).Address, , , , , 8) 
Err.Clear 
If rngErste Is Nothing Then GoTo Benutzerabbruch: 
 
'Datei lesen 
strInhalt = TxT_ReadAll(strDatei) 
 
If strInhalt = "" Then 'Datei leer? 
 MsgBox "Die Datei ist leer! Der Import wird abgebrochen!", vbInformation 
 Exit Sub 
End If 
 
myAr = Split(strInhalt, vbCr) 
 
    With Application 
      iCalc = .Calculation 
     .ScreenUpdating = False 
     .EnableEvents = False 
     .Calculation = xlCalculationManual 
         
        On Error GoTo ErrorHandler: 
         
        For A = Lbound(myAr) To Ubound(myAr) 
         myAr(A) = Application.WorksheetFunction.Clean(myAr(A)) 
         myArZeile = Split(myAr(A), strDel) 
            
           If Ubound(myArZeile) > -1 Then 
              
             'Textzahlen in Zahl umwandeln 
             myArNum = rngErste.Resize(, Ubound(myArZeile) + 1) 
             For B = 1 To Ubound(myArNum, 2) 
                If IsNumeric(myArZeile(B - 1)) And myArZeile(B - 1) <> "" Then 
                 myArNum(1, B) = myArZeile(B - 1) * 1 
                Else 
                 myArNum(1, B) = myArZeile(B - 1) 
                End If 
             Next B 
              
             rngErste.Resize(, Ubound(myArZeile) + 1) = myArNum 
             Set rngErste = rngErste.Offset(1, 0) 
           End If 
        Next A 
         
        ActiveSheet.UsedRange.EntireColumn.AutoFit 
      
ErrorEnd: 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = xlCalculationAutomatic ' iCalc 
    End With 
 
Exit Sub 
 
Benutzerabbruch: 
MsgBox "Der Import wurde vom Benutzer abgebrochen!", vbInformation 
Exit Sub 
 
ErrorHandler: 
MsgBox "Es sind Fehler bei der Verarbeitung aufgetreten!" & vbCr & vbCr & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Error" 
GoTo ErrorEnd: 
End Sub 


Gruß Tino

Lade doch mal ein Beispiel hoch, ....
Backowe

Hi Jordan,
... ansonsten verantstalten wir nur ein heiteres Rätselraten!
Gruß Jürgen
Hast recht, mach ich morgen.....
Jordan

Danke trotzdem für Eure Ideen
Beispiele anbei...
Jordan

Hallo Zusammen,
hier nun mal zwei Beispiele. Leider geht der Upload einer *.csv Datei nicht. Drum hab ich die hier im Textformat hochgeladen.
Also: Hier nun meine Muster CSV Datei:
https://www.herber.de/bbs/user/62925.txt
Und wenn ich die mit dem Code von Jürgen öffne

Sub CSVOeffnen()
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName  False Then _
Workbooks.OpenText DateiName, Semicolon:=True
End Sub


, dann kommt das ganze so raus
https://www.herber.de/bbs/user/62926.xls
Die Lösung von Tino hab ich noch nicht versucht!
Viele Grüße
Jordan

CSV-Datei öffnen
Backowe

Hi Jordan,
öffne sie einfach so:
VBA-Code:
Sub CSVOeffnen()
  Dim i&, n&
  Dim Zeile As String
  Dim Ergebnis As Variant
  Dim DateiName As Variant
  DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
  If DateiName <> False Then
    i = 1
    Open DateiName For Input As #1
    Do While Not EOF(1)
      Line Input #1, Zeile
      Ergebnis = Split(Zeile, ";")
      For n = 0 To UBound(Ergebnis)
        Cells(i, n + 1) = Ergebnis(n)
      Next
      i = i + 1
    Loop
    Close #1
  End If
End Sub
Gruß Jürgen
Klappt!
Jordan

Danke Jürgen,
ich steig zwar nicht so ganz dahinter, was da in dem Makro abläuft! Aber es geht.
Danke!
Anzeige
AW: CSV öffnen
03.07.2009 20:59:32
Jordan
Danke Jürgen,
ich hab meinen PC grad ausgemacht und wollt mich auf die Couch schmeißen. Ich werds morgen spätestens übermorgen ausprobieren und mich dann melden.
Trotzdem danke im voraus!
Leider der gleiche Fehler
04.07.2009 09:01:49
Jordan
Hallo Jürgen,
habs gerade versucht! Hier passiert mir der gleiche Fehler, den ich schon hatte. Die Auswahl steht zwar auf csv, jedoch wird die Datei nicht aufbereitet und es sind nur die ersten zwei Spalten mit allen Daten gefüllt!
Hast du noch eine Idee?
Welches Trennzeichen ...
04.07.2009 09:05:00
Backowe
Hi Jordan,
... wird denn verwendet?
Gruß Jürgen
AW: Welches Trennzeichen ...
04.07.2009 10:01:08
Jordan
Hi Jürgen,
das Semikolon. Hab ich aber schon umgestellt. Sprich ....Semicolon:=True.
Bringt aber das gleiche Ergebnis
Anzeige
vielleicht gehts hiermit...
04.07.2009 11:59:07
Tino
Hallo,
habe hier auch mal was zusammengebaut.
Es wird nach der Datei, nach den Trennzeichen und ab welcher Zelle der Import beginnen soll.
kommt als Code in Modul1
Option Explicit 
                 
Function TxT_ReadAll(ByVal sFilename As String) As String 
Dim F As Integer 
Dim sInhalt As String 
 
  If Dir$(sFilename, vbNormal) <> "" Then 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
  End If 
   
  TxT_ReadAll = sInhalt 
End Function 
 
Sub ImportCSV() 
Dim strDel As String, strInhalt As String, strDatei As String 
Dim rngErste As Range 
Dim myAr, myArZeile, myArNum 
Dim A As Long, B As Long 
Dim iCalc As Integer 
 
'Abfrage Datei 
strDatei = Application.GetOpenFilename("CSV Files (*.csv), *.csv, Text File(*.txt),*.txt") 
If strDatei = CStr(False) Then GoTo Benutzerabbruch: 
 
'Abfrage für Trennzeichen 
AbfrageDelimiter: 
strDel = InputBox("Geben Sie das verwendete Trennzeichen der CSV Datei ein", "CSV- Delimeter?") 
If StrPtr(strDel) = 0 Then GoTo Benutzerabbruch: 
 
If strDel = "" Then 
 If MsgBox("Sie haben kein Delimiter eingegeben!" & vbCr & _
           "Wollen Sie den Vorgang wiederholen drücken Sie auf 'Wiederhohlen'" & vbCr & _
           "Wollen Sie den Vorgang abbrechen drücken auf 'Abbrechen'", vbRetryCancel, "Keine Trennzeichen") = vbRetry Then 
             GoTo AbfrageDelimiter: 
 Else 
  Exit Sub 
 End If 
End If 
 
'Abfrage erste Zelle 
On Error Resume Next 
Set rngErste = Application.InputBox("In welcher Zelle soll der Import beginnen?", "Zelle auswählen", Selection(1).Address, , , , , 8) 
Err.Clear 
If rngErste Is Nothing Then GoTo Benutzerabbruch: 
 
'Datei lesen 
strInhalt = TxT_ReadAll(strDatei) 
 
If strInhalt = "" Then 'Datei leer? 
 MsgBox "Die Datei ist leer! Der Import wird abgebrochen!", vbInformation 
 Exit Sub 
End If 
 
myAr = Split(strInhalt, vbCr) 
 
    With Application 
      iCalc = .Calculation 
     .ScreenUpdating = False 
     .EnableEvents = False 
     .Calculation = xlCalculationManual 
         
        On Error GoTo ErrorHandler: 
         
        For A = Lbound(myAr) To Ubound(myAr) 
         myAr(A) = Application.WorksheetFunction.Clean(myAr(A)) 
         myArZeile = Split(myAr(A), strDel) 
            
           If Ubound(myArZeile) > -1 Then 
              
             'Textzahlen in Zahl umwandeln 
             myArNum = rngErste.Resize(, Ubound(myArZeile) + 1) 
             For B = 1 To Ubound(myArNum, 2) 
                If IsNumeric(myArZeile(B - 1)) And myArZeile(B - 1) <> "" Then 
                 myArNum(1, B) = myArZeile(B - 1) * 1 
                Else 
                 myArNum(1, B) = myArZeile(B - 1) 
                End If 
             Next B 
              
             rngErste.Resize(, Ubound(myArZeile) + 1) = myArNum 
             Set rngErste = rngErste.Offset(1, 0) 
           End If 
        Next A 
         
        ActiveSheet.UsedRange.EntireColumn.AutoFit 
      
ErrorEnd: 
     .ScreenUpdating = True 
     .EnableEvents = True 
     .Calculation = xlCalculationAutomatic ' iCalc 
    End With 
 
Exit Sub 
 
Benutzerabbruch: 
MsgBox "Der Import wurde vom Benutzer abgebrochen!", vbInformation 
Exit Sub 
 
ErrorHandler: 
MsgBox "Es sind Fehler bei der Verarbeitung aufgetreten!" & vbCr & vbCr & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Error" 
GoTo ErrorEnd: 
End Sub 


Gruß Tino

Anzeige
Lade doch mal ein Beispiel hoch, ....
04.07.2009 12:21:30
Backowe
Hi Jordan,
... ansonsten verantstalten wir nur ein heiteres Rätselraten!
Gruß Jürgen
Hast recht, mach ich morgen.....
04.07.2009 14:44:19
Jordan
Danke trotzdem für Eure Ideen
Beispiele anbei...
05.07.2009 12:33:00
Jordan
Hallo Zusammen,
hier nun mal zwei Beispiele. Leider geht der Upload einer *.csv Datei nicht. Drum hab ich die hier im Textformat hochgeladen.
Also: Hier nun meine Muster CSV Datei:
https://www.herber.de/bbs/user/62925.txt
Und wenn ich die mit dem Code von Jürgen öffne

Sub CSVOeffnen()
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName  False Then _
Workbooks.OpenText DateiName, Semicolon:=True
End Sub


, dann kommt das ganze so raus
https://www.herber.de/bbs/user/62926.xls
Die Lösung von Tino hab ich noch nicht versucht!
Viele Grüße
Jordan

Anzeige
CSV-Datei öffnen
05.07.2009 13:45:10
Backowe
Hi Jordan,
öffne sie einfach so:
VBA-Code:
Sub CSVOeffnen()
  Dim i&, n&
  Dim Zeile As String
  Dim Ergebnis As Variant
  Dim DateiName As Variant
  DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
  If DateiName <> False Then
    i = 1
    Open DateiName For Input As #1
    Do While Not EOF(1)
      Line Input #1, Zeile
      Ergebnis = Split(Zeile, ";")
      For n = 0 To UBound(Ergebnis)
        Cells(i, n + 1) = Ergebnis(n)
      Next
      i = i + 1
    Loop
    Close #1
  End If
End Sub
Gruß Jürgen
Klappt!
Jordan

Danke Jürgen,
ich steig zwar nicht so ganz dahinter, was da in dem Makro abläuft! Aber es geht.
Danke!
Anzeige
Klappt!
05.07.2009 17:17:28
Jordan
Danke Jürgen,
ich steig zwar nicht so ganz dahinter, was da in dem Makro abläuft! Aber es geht.
Danke!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige