Textimport über Inputbox - Text anhängen

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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")

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

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

Beliebteste Forumthreads (12 Monate)

Textimport über Inputbox - Text anhängen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Textimport über Inputbox - Text anhängen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread