Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

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"