HERBERS Excel-Forum - VBA-Basics

Thema: Textimport

Inhaltsverzeichnis
  • 1 Import zur Anzeige in MsgBoxes
  • 2 Import zur Konvertierung in eine HTML-Seite
  • 3 Import zur Anzeige in einem Arbeitsblatt
  • 4 Import zur Übernahme in UserForm-Controls
  • Import zur Anzeige in MsgBoxes

    
    Sub WriteInMsgBoxes()
       Dim cln As New Collection
       Dim arrAct As Variant
       Dim intNo As Integer, intCounter As Integer
       Dim txt As String, strMsg As String
       Dim bln As Boolean
       intNo = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intNo
       Do Until EOF(intNo)
          If bln = False Then
             Line Input #intNo, txt
             arrAct = SplitString(txt, ",")
             For intCounter = 1 To UBound(arrAct)
                cln.Add arrAct(intCounter)
             Next intCounter
          Else
             Line Input #intNo, txt
             arrAct = SplitString(txt, ",")
             For intCounter = 1 To UBound(arrAct)
                strMsg = strMsg & cln(intCounter) & ": " & _
                   arrAct(intCounter) & vbLf
             Next intCounter
          End If
          If bln Then MsgBox strMsg
          bln = True
          strMsg = ""
       Loop
       Close intNo
    End Sub
    
    

    Import zur Konvertierung in eine HTML-Seite

    
    Sub WriteInHTML()
       Dim arrAct As Variant
       Dim intSource As Integer, intTarget As Integer, intCounter As Integer
       Dim txt As String, strTag As String
       Dim bln As Boolean
       intTarget = FreeFile
       Open ThisWorkbook.Path & "\TextImport.htm" For Output As #intTarget
       Print #intTarget, "<html><body><table>"
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
       Do Until EOF(intSource)
          If bln Then strTag = "td" Else strTag = "th"
          Line Input #intSource, txt
          arrAct = SplitString(txt, ",")
          Print #intTarget, "<tr>"
          For intCounter = 1 To UBound(arrAct)
             Print #intTarget, "<" & strTag & ">" & arrAct(intCounter) & "</" & strTag & ">"
          Next intCounter
          Print #intTarget, "</tr>"
          bln = True
       Loop
       Close intSource
       Print #intTarget, "</table></body></html>"
       Close intTarget
       Shell "hh " & ThisWorkbook.Path & "\TextImport.htm", vbMaximizedFocus
    End Sub
    
    

    Import zur Anzeige in einem Arbeitsblatt

    
    Sub WriteInWks()
       Dim cln As New Collection
       Dim arrAct As Variant
       Dim intSource As Integer, intRow As Integer, intCol As Integer
       Dim txt As String
       Workbooks.Add
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
       Do Until EOF(intSource)
          Line Input #intSource, txt
          arrAct = SplitString(txt, ",")
          intRow = intRow + 1
          For intCol = 1 To UBound(arrAct)
             Cells(intRow, intCol).Value = arrAct(intCol)
          Next intCol
       Loop
       Close intSource
       Rows(1).Font.Bold = True
    End Sub
    

    Import zur Übernahme in UserForm-Controls

    In einem Standardmodul:

    
    Public garr() As String
    Public gint As Integer
    

    Im Klassenmodul der UserForm:

    
    Private Sub cmdCancel_Click()
       Unload Me
    End Sub
    
    Private Sub cmdWeiter_Click()
       Dim intCounter As Integer
       If gint <= 4 Then gint = gint + 1 Else gint = 1
       For intCounter = 1 To 5
          Controls("TextBox" & intCounter).Text = garr(gint, intCounter)
       Next intCounter
    End Sub
    
    Private Sub UserForm_Initialize()
       Dim arrAct As Variant
       Dim intSource As Integer, intCounter As Integer, intRow As Integer
       Dim txt As String
       Dim bln As Boolean
       gint = 0
       intSource = FreeFile
       Open ThisWorkbook.Path & "\TextImport.txt" For Input As #intSource
       Do Until EOF(intSource)
          Line Input #intSource, txt
          arrAct = SplitString(txt, ",")
          If bln = False Then
             For intCounter = 1 To UBound(arrAct)
                Controls("Label" & intCounter).Caption = _
                   arrAct(intCounter) & ":"
             Next intCounter
             ReDim garr(1 To 5, 1 To UBound(arrAct))
          Else
             intRow = intRow + 1
             For intCounter = 1 To UBound(arrAct)
                garr(intRow, intCounter) = arrAct(intCounter)
             Next intCounter
          End If
          bln = True
       Loop
       Close intSource
    End Sub
    
    

    Für alle vorstehende Routinen wird die folgende benutzerdefinierte Funktion in einem Standardmodul benötigt (Die Funktion macht unabhängig von der erst ab XL2000 verfügbaren VBA-Funktion Split:

    
    Function SplitString(ByVal txt As String, strSeparator As String)
       Dim arr() As String
       Dim intCounter As Integer
       Do
          intCounter = intCounter + 1
          ReDim Preserve arr(1 To intCounter)
          If InStr(txt, strSeparator) Then
             arr(intCounter) = Left(txt, InStr(txt, strSeparator) - 1)
             txt = Right(txt, Len(txt) - InStr(txt, strSeparator))
          Else
             arr(intCounter) = txt
             Exit Do
          End If
       Loop
       SplitString = arr
    End Function