VBA in Excel/ Textimport

|

Import zur Anzeige in MsgBoxes

Beim Import mit der Funktion Line Input sucht Excel nach Zeichen, die das Zeilenende ankündigen. Wurde eine Datei unter Windows geschrieben, endet eine Zeile üblicherweise mit zwei Zeichen: CHR(13) und CHR(10), also Wagenrücklauf (CR = Carriage Return) und Zeilenvorschub (LF = LineFeed). Mac-Dateien enden üblicherweise mit CHR(13) und Unix-Dateien enden üblicherweise mit CHR(10). 'Üblicherweise' meint, dass dies für Textdateien gilt, die das Betriebssystem schreibt und die als Konvention auch so von vielen Anwendungen von ihrem jeweiligen Betriebssystem übernommen wird. Es gibt aber auch Anwendungen, die auf mehreren Betriebssystemen laufen und andere oder überall die gleiche Konvention für das Zeilenende verwenden.

Excel gibt es für Windows und Mac, daher werden von Line Input sowohl CR+LF als auch CR als Zeilenendzeichen erkannt. Ein einfaches LF oder andere Symbole werden versteht Excel nicht als Zeilenende und liest dann so lange ein, bis der Puffer voll ist – die eingelesene Zeichenfolge kann in diesem Falle mehrere zehntausend Byte lang werden.

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, intTarget, intCounter As Integer    
   Dim txt, 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

|

Hoch zu „Inhaltsverzeichnis“ |