PLZ aus Textdatei als Text in Excel schreiben!

[cysu11]

Hallo liebe Excelgemeinde,


benötige mal wieder eure Hilfe! :)

mit folgenden lese ich eine Textdatei ins Excel ein und verteil diese entsprechend in Spalten!
In Spalte M habe ich die PLZ stehen und da wird z.B. bei der PLZ 01407 nur 1407 in den Spalten übertragen.
Wie kann ich den Code ändern/ergänzen, dass diese Spalte als Text übertragen wird?

Code:

Sub DatenImport() 'Lieferungen
   
Wahl = MsgBox("Sind Sie sicher, dass Sie die Daten importieren möchten?", vbYesNo)
If Wahl <> 6 Then Exit Sub
Workbooks.OpenText Filename:= _
"C:\TempData\abfrage.txt", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array( _
10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
ActiveWorkbook.SaveAs Filename:= _
       "C:\TempData\abfrage1.xls"
Dim loletzte As Long
   loletzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Range("A1:O" & loletzte).Select
Selection.Copy
Workbooks("NEU.xlsm").Activate
Sheets("Lieferungen").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A65536").End(xlUp).Offset(1, 0).Select
Application.CutCopyMode = False
Call SortierenLieferungen
Workbooks("abfrage1.xls").Activate
Workbooks("abfrage1.xls").Close SaveChanges:=False
Kill "C:\TempData\abfrage1.xls"
Kill "C:\TempData\abfrage1.txt"
Range("A7").Select
Call ZusammenFuehrenUndAusgeben
MsgBox ("Daten wurden erfolgreich importiert!")
End Sub

Vielen Dank
VG
Alexandra

[Kuwer]

Hallo Alexandra,

teste mal so (2 steht für Textformat):

Sub DatenImport() 'Lieferungen
  
Wahl = MsgBox("Sind Sie sicher, dass Sie die Daten importieren möchten?", vbYesNo)
If Wahl <> 6 Then Exit Sub
Workbooks.OpenText Filename:= _
"C:\TempData\abfrage.txt", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array( _
10, 1), Array(11, 1), Array(12, 1), Array(13, 2), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
ActiveWorkbook.SaveAs Filename:= _
      "C:\TempData\abfrage1.xls"
Dim loletzte As Long
  loletzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Range("A1:O" & loletzte).Select
Selection.Copy
Workbooks("NEU.xlsm").Activate
Sheets("Lieferungen").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A65536").End(xlUp).Offset(1, 0).Select
Application.CutCopyMode = False
Call SortierenLieferungen
Workbooks("abfrage1.xls").Activate
Workbooks("abfrage1.xls").Close SaveChanges:=False
Kill "C:\TempData\abfrage1.xls"
Kill "C:\TempData\abfrage1.txt"
Range("A7").Select
Call ZusammenFuehrenUndAusgeben
MsgBox ("Daten wurden erfolgreich importiert!")
End Sub

Gruß Uwe

[cysu11]

Hi Uwe,


das wars? :)

Es funktioniert prima!!


Vielen Dank & schönes Wochenende
VG
Alexandra