Textimport über Inputbox - Text anhängen
Betrifft: Textimport über Inputbox - Text anhängen
von: Wolfgang
Geschrieben am: 03.11.2012 16:42:19
Hallo,
mit nachfolgendem Code würde ich gerne erreichen, dass über eine Inputbox eine Textdatei gesucht werden kann und die Daten der markierten Textdatei in Spalte A importiert werden, allerdings sollten sie angehängt, also, in die nächst freie Zelle eingefügt werden. Den Code habe ich mit dem Makrorekorder aufgezeichnet, bei meinen Umstellungwünschen: Suchen in Inputbox und Daten anhängen scheitere ich allerdings. Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Sub Import()
Dim sFilename As String
sFilename = Application.GetOpenFilename("Text File (*.txt),*.txt")
If sFilename <> CStr(False) Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Dokumente und Einstellungen\*******Desktop\**.txt", _
Destination:=Range("$A$1"))
'.Name = "*****"
.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 = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
_
9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
_
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
  |
Betrifft: AW: Textimport über Inputbox - Text anhängen
von: fcs
Geschrieben am: 04.11.2012 01:16:58
Hallo Wolfgang,
das mit der Inputbox verstehe ich nicht. Du zeigst doch ein Dialogfenster für die Dateiauswahl an.
Ansonsten muss du den Code wie folgt anpassen, damit der Dateiname und die Einfügezelle variabel werden.
Gruß
Franz
Sub Import()
Dim vFilename As Variant, wks As Worksheet, rngZelle As Range
Set wks = ActiveSheet
With wks
Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, Searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
Set rngZelle = .Cells(1, 1)
Else
Set rngZelle = wks.Cells(rngZelle.Row + 1, 1)
End If
End With
vFilename = Application.GetOpenFilename("Text File (*.txt),*.txt")
If vFilename <> False Then
With wks.QueryTables.Add(Connection:="TEXT;" & vFilename, Destination:=rngZelle)
'.Name = "*****"
.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 = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
| |
Betrifft: AW: Textimport über Inputbox - Text anhängen
von: Wolfgang
Geschrieben am: 04.11.2012 07:29:21
Hallo Franz,
herzlichen Dank erneut für Deine Rückmeldung. Ich habe den Code soweit eingebaut. Hätte noch eine Frage/Bitte: Was müßte ich ändern, damit sich der Code ausschließlich nach Spalte A richtet und ab A1 bzw. dann in die nächstfreie Zelle den Text einfügt. Momentan fügt der Code nach Zeilenbelegung ein; Ich habe nämlich noch in Spalte B (bis B21) Text, der Code fügt nun nach Ende des Textes, also ab B22 erst die Daten aus der Textdatei ein. Danke schon jetzt für die Rückmeldung.
Gruß - Wolfgang
Betrifft: AW: Textimport über Inputbox - Text anhängen
von: fcs
Geschrieben am: 04.11.2012 15:31:47
Hallo Wolfgang,
dann muss die Einfügezelle etwas anders ermittelt werden.
Gruß
Franz
Sub Import()
Dim vFilename As Variant, wks As Worksheet, rngZelle As Range
Set wks = ActiveSheet
With wks
Set rngZelle = .Cells(.Rows.Count, 1).End(xlUp)
If Not IsEmpty(rngZelle) Then
Set rngZelle = rngZelle.Offset(1, 0)
End If
End With
vFilename = Application.GetOpenFilename("Text File (*.txt),*.txt")
| |
Betrifft: Danke Franz !!!
von: Wolfgang
Geschrieben am: 04.11.2012 16:16:35
Hallo Franz,
Danke recht herzlich für Deine erneute Meldung und Änderungen zu Deinem Code. Ich habe sie entsprechend "eingebaut" und der Code läuft super. Er fügt nun nahtlos die jeweiligen Daten aus den Textdateien (es geht um das Einfügen von Daten aus mehreren Textdateien) ein.
Ich hoffe, meine ergänzende Frage, die mit diesem Code unmittelbar nichts mehr zu tun hat, ist nicht unverschämt. Wie könnte der Code aussehen, wenn ich gleiches Ziel, wie in dem Code von Dir verfolge, nur die Daten in diesem Fall aus der Zwischenablage kommen und eben wieder in Spalte A jeweils in die nächste freie Zelle eingefügt werden sollen. Danke nochmals für Deinen Code bzgl. der Textdatei, Du hast mir da sehr geholfen!
Gruß - Wolfgang
| |
Betrifft: Text in Zwischenablage selektiv importieren
von: fcs
Geschrieben am: 05.11.2012 01:30:56
Hallo Wolfgang,
das wird dann erheblich komplizierter, da verschiedene Prüfungen gemacht werden müssen und der Text in seine Einzelteile zerlegt werden muss.
Gruß
Franz
Sub aaImport_Text_from_Clipboard()
'im VBA-Editor muss für die Datei mit dem Makro unter Extras--Verweise der Verweis auf
'Microsoft Forms x.x Object Library
'gesetzt sein!
Dim wks As Worksheet, rngZelle As Range, strText As String
Dim varSplit, lngI As Long, varSplit2
Dim lngOffset As Long
Dim MyData As New dataobject
Const strSep As String = "|" 'Trennzeichen in Textzeilen
Const lngStartRow As Long = 2 'Einlesen ab Zeile
For Each varSplit In Application.ClipboardFormats
'Prüfen, ob Text in Zwischenablage
If varSplit = xlClipboardFormatText Then
MyData.GetFromClipboard
strText = MyData.GetText
'Prüfen, ob Trennzeichen im Text
If InStr(1, strText, strSep) > 0 Then
Set wks = ActiveSheet
With wks
Set rngZelle = .Cells(.Rows.Count, 1).End(xlUp)
If Not IsEmpty(rngZelle) Then
Set rngZelle = rngZelle.Offset(1, 0)
End If
End With
'Text aus Zwischenablage auf Zeilenschaltungen prüfen und Text an _
Zeilenschaltung splitten
If InStr(1, strText, Chr(13) & Chr(10)) > 0 Then
strText = VBA.Replace(strText, Chr(13), "")
varSplit = Split(strText, Chr(10))
ElseIf InStr(1, strText, Chr(13)) > 0 Then
varSplit = Split(strText, Chr(13))
ElseIf InStr(1, strText, Chr(10)) > 0 Then
varSplit = Split(strText, Chr(10))
Else
varSplit = Array(strText)
End If
For lngI = LBound(varSplit) + lngStartRow - 1 To UBound(varSplit)
If InStr(1, varSplit(lngI), strSep) > 0 Then
varSplit2 = Split(varSplit(lngI), strSep)
'Inhalt aus 2. Spalte des Arrays ohne führende/nachgestellte Leerzeichen einfügen
rngZelle.Offset(lngOffset, 0) = Trim(varSplit2(1))
lngOffset = lngOffset + 1
End If
Next
Erase varSplit
If IsArray(varSplit2) Then Erase varSplit2
Else
MsgBox "Trennzeichen """ & strSep & """ ist im Text in Zwischenablage nicht vorhanden."
End If
GoTo Beenden
End If
Next
MsgBox "Kein Text in Zwischenablage"
Beenden:
Set MyData = Nothing
Set wks = Nothing
End Sub
| |
Betrifft: sorry Franz, hatte mich nicht korrekt ausgedrückt
von: Wolfgang
Geschrieben am: 05.11.2012 11:49:20
Hallo Franz,
erneut herzlichen Dank für Deine Rückmeldung und insbesondere für die enorme Ausarbeitung des Codes. Sorry, dass ich mich nicht korrekt ausgedrückt hatte und vielleicht das konkrete Ziel nicht näher beschrieben hatte. Der Weg mit der Zwischenablage und weiterhin das Einfügen in Spalte A bzw. "dranhängen" wäre mein Wunsch. Ich hatte vergessen, so stelle ich jetzt fest, Dir mitzuteilen, dass es sich um simplen Text handelt, der keine Trennzeichen o.ä enthält. Momentan meldet der Code nun, dass das Zeichen | nicht vorhanden ist. Nochmals Sorry, dass ich Dir nun soviel Arbeit bereitet habe, aber auch nochmals herzlichen Dank!
Gruß - Wolfgang
| |
Betrifft: @ Franz - Ergänzung
von: Wolfgang
Geschrieben am: 05.11.2012 12:48:48
Hallo Franz,
mein schlechtes Gewissen lässt mir keine Ruhe und ich habe überlegt, wie ich es hätte anders erklären können. Dabei fiel mir der Makrorekorder ein (folgender Code). Ich markiere in dem Moment nun die Zelle A, rechte Maustaste und einfügen. Problem hierbei ist nur, dass ich über den Makrorekorder nicht hinbekomme, dass die nächstfreie Zelle gesucht wird (in Spalte A) und ab hier dann begonnen wird, den Text aus der Zwischenablage einzufügen. Nochmals herzlichen Dank.
Gruß - Wolfgang
Sub Makro1()
ActiveSheet.Paste
End Sub
Betrifft: AW: @ Franz - Ergänzung
von: fcs
Geschrieben am: 05.11.2012 21:37:57
Hallo Wolfgang,
probier mal die folgende Variante.
Was auch immer in der Zwischenablage sich befindet wird in Spalte A ab der nächsten frein Zeile eingefügt.
Gruß
Franz
Sub aaImport_Text_from_Clipboard()
Dim wks As Worksheet, rngZelle As Range, strText As String
Set wks = ActiveSheet
With wks
Set rngZelle = .Cells(.Rows.Count, 1).End(xlUp)
If Not IsEmpty(rngZelle) Then
Set rngZelle = rngZelle.Offset(1, 0)
End If
End With
rngZelle.Select
ActiveSheet.Paste
Set wks = Nothing
End Sub
Betrifft: Danke Franz!!
von: Wolfgang
Geschrieben am: 06.11.2012 05:53:26
Hallo Franz,
herzlichen Dank! - Genau das ist es, was ich mir gewünscht hatte - der Code läuft einwandfrei. Danke auch für Deine Geduld mit mir.
Gruß - Wolfgang
Beiträge aus den Excel-Beispielen zum Thema "Textimport über Inputbox - Text anhängen"
Screenshot zu InputBox
Screenshot zu MsgBox