mit der unbezahlbaren Hilfe von Franz habe ich nun einen Code, der mir dabei hilft per Knopfdruck eine *txt Datei in meine Tabelle zu importieren.
Ich versuche nun seid drei Tagen mir diesen Code so "umzuschreiben", das er mir während des Imports NICHT die Spaltenbreite angepasst wird...sie soll bleibenn wie sie ist.
Desweiteren muss ich in einem anderen Blatt ebenfalls eine *txt-Datei importieren. Da brauche ich allerdings nicht alle Spalten und Zeilen. Erste Zeile der txt-Datei kann weg bleiben. Und ich brauche nur die Spalte B C F H K. Die Spaltenbreite darf ebenfalls nicht verändert werden!!
Wie gesagt mit Hilfe von Franz habe ich den ersten Import (bis auf die feste Spaltenbreite) hinbekommen.
Folgende Codes sorgen für einen reibungslosen Import:
Option Explicit
Sub texteinfuegen()
Dim varTextDatei
Dim strPfadAkt As String, rngEinfuegZelle As Range
strPfadAkt = VBA.CurDir 'Aktives Verzeichnis merken
VBA.ChDir "Macintosh HD:Users:Shared:" 'Verzeichnis mit Textdateien
varTextDatei = Application.GetOpenFilename( _
Title:="Bitte Textdatei mit Daten auswählen und öffnen")
If varTextDatei False Then
If InStr(1, LCase(varTextDatei), "etik") > 0 Then
'Einfügezelle ermitteln
With ActiveSheet
If .Cells(.Rows.Count, 1).End(xlUp).Row >= 5 Then
Set rngEinfuegZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Set rngEinfuegZelle = .Range("A5")
End If
End With
'Querrydaten holen
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varTextDatei, Destination:=rngEinfuegZelle)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.Refresh BackgroundQuery:=False
End With
Dim objQuerry As QueryTable
'Querries löschen
For Each objQuerry In ActiveSheet.QueryTables
objQuerry.Delete
Next
Else
MsgBox "Gewählt: " & varTextDatei & vbLf _
& "Bitte eine Textdatei wählen, deren Name mit ""etik"" beginnt!"
End If
End If
VBA.ChDir strPfadAkt 'aktuelles Verzeichnis zurücksetzen
End Sub
Und für das löschen der Querries (wenn ich das richtig verstanden habe wird diese in der Procedur oben
aufgerufen? da kann ich mich allerdings auch irren mit fast NULL VBA Kenntnissen) noch folgende Procedur:
Option Explicit
Sub QuerriesLoeschen()
Dim wks As Worksheet
Dim objQuerry As QueryTable
Set wks = Worksheets("Wareneingang")
'Querries löschen
For Each objQuerry In wks.QueryTables
objQuerry.Delete
Next
'Daten löschen
With wks
If .Cells(.Rows.Count, 1).End(xlUp).Row >= 5 Then
.Range(.Cells(5, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 7)).ClearContents
End If
End With
End Sub
Ich habe nun versucht ein Makro aufzuzreichen.(da der Dateiname der 2ten txt Datei die ich importieren will ja immer gleich heissen kann (User entscheidet)) Aber ehrlich gesagt ist mir das zu unsicher, da ich nicht sicher bin ob wirklich immer jeder am gleichen Ort abspeichert. Die Datei muss also vorher auswählbar sein.
Folgendes Makro funktioniert zwar aber wie gesagt:Die Querris werden nicht wie oben gelöscht,die Spaltenbreite wird nicht wirklich Fehlerfrei in Ruhe gelassen und ich kann die Datei vorher nicht wählen (sie sollte immer best.txt heissen sonst msgbox:)
Sub besteinfuegen()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Macintosh HD:Users:Shared:best.txt", Destination:=Range("A3"))
.Name = "best"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 9, 9, 1, 9, 1, 9, 9, 1, 9)
.Refresh BackgroundQuery:=False
.UseListObject = False
End With
P.S. habe das Makro aufgezeichnet und den Haken bei "Spaltenbreite anpassen" rausgenommen. Führe ich es aus funzt es gerade zu traumhaft ABER ich bekomme nach dem Import einen Laufzeitfehler 1004 und er schimpft in Zeile:
.Refresh BackgroundQuery:=False
Ich hoffe sehr das mir wieder jemand (vielleicht sogar Franz ;o)) helfen kann. Komme einfach nicht weiter.
1000 mal danke!!
lg
J.