Office: lange Zahl als Text einlesen, VBA, TextToColumns

Hallo zusammen,

ich habe folgendes Problem, wozu ich im Internet noch keine Lösung zu gefunden habe:
Ich möchte mit VBA und der Funktion TextToColumns eine CSV-Datei einlesen.
Das klappt auch soweit. Jetzt ist nur ein Wert eine Zahl mit 16 Zeichen.
Diese wird dann immer von 7511418123456789 zu einer Exponential-Zahl oder zu 7511418123456700 abgekürzt.
Ich weiß, dass Excel (2010 nutze ich) nur mit max. 15 Stellen arbeiten kann.
Ich benötige aber auf jeden Fall die Zahl als ganzes.
Jetzt meine Frage:
Wie kann ich die lange Zahl mit der oben genannten Funktion als Text einlesen?

Danke im Voraus
Gruß
Henrik

Hier mein Code (ist zwar wahrscheinlich sehr unschön geschrieben, aber funktioniert für meine Bedurfnisse :D ):

Code:

Sub Pruefzeiten_AW_alt()

     Dim AppShell As Object
     Dim BrowseDir As Variant
     Dim CSVPFAD As String

     Set AppShell = CreateObject("Shell.Application")
     Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
     On Error Resume Next
     CSVPFAD = BrowseDir.items().Item().Path
     If CSVPFAD = "" Then Exit Sub
     
     'On Error GoTo 0
     
    'Const CSVPFAD = "H:\WP-Fertigung\Auswertungen\Prüfzeitauswertung\Funktionsprüfstand AW alt Linie 2\asdf"
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set wbTarget = ActiveWorkbook
    Application.DisplayAlerts = False
    'Lösche alle Worksheets bevor wir alle neu anlegen
    While wbTarget.Worksheets.Count > 1
            wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"
    wbTarget.Worksheets(1).Range("A:ZZ").Clear
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(Right(f.Name, 3)) = "txt" Then
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets(f.Name)
            If Err <> 0 Then
                Set ws = wbTarget.Worksheets.Add
                ws.Name = f.Name
                ws.Range("A:ZZ").Clear
            End If
        
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True, FieldInfo:=Array(Array(1, 2))
            wbSource.Worksheets(1).Range("B2").Copy Destination:=ws.Range("A1")
            wbSource.Worksheets(1).Range("B5").Copy Destination:=ws.Range("B1")
            wbSource.Worksheets(1).Range("B6").Copy Destination:=ws.Range("C1")
            ws.Range("B1:C1").NumberFormat = "[$-F400]h:mm:ss AM/PM"
            Dim a2 As Date, a3 As Date, a21 As Date, a31 As Date
            ws.Range("A1").NumberFormat = "@"
            a2 = ws.Range("B1")
            a3 = ws.Range("C1")
            a21 = (Right(a2, 8))
            a31 = (Right(a3, 8))
            ws.Range("D1") = a31 - a21
            ws.Range("D1").NumberFormat = "[$-F400]h:mm:ss AM/PM"
            
            wbSource.Close False
        End If
    Next
    Set ts = wbTarget.Worksheets("Zusammenfassung")
    Dim curCell As Range
    ts.Range("A1") = "Herstellnummer"
    ts.Range("B1") = "Prüfung Start"
    ts.Range("C1") = "Prüfung Ende"
    ts.Range("D1") = "Prüfzeit"
    Set curCell = ts.Range("A2")
    
    For i = 1 To wbTarget.Worksheets.Count - 1
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(1, 4)).Copy Destination:=curCell
        'MsgBox maxCol
        'Set curCell = curCell.End(xlDown).Offset(1, 0)
        Set curCell = curCell.Offset(1, 0)
    Next
    Application.DisplayAlerts = True
    ts.Range("A:A").NumberFormat = "################"
    ts.Columns("A:ZZ").EntireColumn.AutoFit
   
    
    
    Set fso = Nothing
End Sub

 

Moinsens!

Das steuerst Du über die "FieldInfo" Eigenschaft der OpenText-Methode:

Code:

    Workbooks.OpenText _
        [...]
        fieldinfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), Array(3, xlTextFormat))

Weitere Infos unter "XlColumnDataType-Enumeration" in der Excel-Hilfe.

Gruß, Michael