Excel VBA Opentext Spaltenbreite definieren

[Madddin]

Hallo liebe Forumgemeinde,

ich habe einen vba code geschrieben, in dem eine txt Datei ausgewählt und eingefügt wird. Für das einfügen der txt Datei habe ich den Opentext - Befehl benutzt.

Um meine benötigten Formatierungen zu bekommen, habe ich vorher das ganze mal manuell gemacht und dies mit den markrorecorder aufgenommen.
Dort wurde dann der QueryTables.Add Befehl genommen, da ich dort über Daten einfügen gegangen bin.

Mein Problem ist, wenn ich diese Einstellungen vom Markorecorder übernehmen will, kann ich das für den Opentext Befehl nur für die Spaltenformate (Standard, text usw.) machen. Ich schaffe es dort einfach nicht die Spaltenbreite und damit die Spaltenanzahl zu definieren. Ohne diese definition macht excel dies automatisch und die spalten verrutschen. Weiß jemand wie das bei dem Opentext Befehl geht?

Alternativ könnte ich ja den QueryTables.Add Befehl aus dem recorder nehmen, leider muss dort aber im Code der Ort der text Datei stehen,oder ist es möglich den Ort durch eine Auswahl (Application.GetOpenFilename) vorzugeben?


Code geschrieben für Texteinfügen. (Mit Opentext , Spaltenbreite und Anzahl wie?)

Option Explicit

Sub OpenTextFile()
  Dim varRetVal     As Variant
  Dim strFileName   As String

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path

  varRetVal = Application.GetOpenFilename( _
        FileFilter:="Text-Dateien (*.txt), *.txt", _
        Title:="Daten aus Text-Datei importieren")

  If varRetVal = False Then Exit Sub

  strFileName = varRetVal

  Workbooks.OpenText Filename:=strFileName, StartRow:=18, _
      DataType:=xlFixedWidth, TextQualifier:=xlTextQualifierDoubleQuote, _
      ConsecutiveDelimiter:=True, Tab:=True, Space:=True, fieldinfo:=Array(Array(1, 2), _
      Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _
      Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10,9))
  

  Dim wkb As Workbook
  Dim wks As Worksheet

  Set wkb = ActiveWorkbook

  strFileName = ThisWorkbook.Path & "\NeueXLDatei.xls"
  wkb.SaveAs Filename:=strFileName, FileFormat:=xlWorkbookNormal

  Set wks = wkb.Worksheets(1)
  wks.Name = "VB"
  wks.UsedRange.Columns.AutoFit

  Set wks = Nothing
  Set wkb = Nothing
End Sub

Code vom Makrorecorder für die Spaltenbreite usw. (Mit QueryTables.Add , geht nur wenn der Ort der txt Dateo fest im code steht, oder doch mit Auswahl möglich?)

Sub Makro2()

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Dokumente und Einstellungen\Martin Bauer\Desktop\In Bearbeitung\Messübertragung\abc.txt" _
        , Destination:=Range("$A$1"))
        .Name = "abc"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 20
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 9)
        .TextFileFixedColumnWidths = Array(5, 10, 12, 11, 11, 11, 10, 10, 22)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Vielen Dank schon mal!
Grüße
Martin

[Madddin]

Nachtrag

Nachrtag = falls es wichtig sein sollte ich benutze Office 2007.