AW: Text-File import
04.02.2017 08:48:22
Tino
Hallo,
habe hier mal was zusammengebaut.
Kannst mal testen!
Du kannst angeben
Pfad -> String
von Zeile -> Long
bis Zeile -> Long
welcher Zeilenumbruch verwendet werden soll -> Optional String
ob Rückgabe als String oder Array -> Optional Enum Aufzählung
ob Array transponiert werden soll,
um diese zBsp. direkt in Zellen zu schreiben. -> Optional Boolean
Modul Modul2
Option Explicit
Enum enuGetTyp
GetString
GetArray
End Enum
Function ReadFile(sPath$, ByVal FromLine&, ByVal ToLine&, Optional LineBreak$ = vbCr, _
Optional GetTyp As enuGetTyp = enuGetTyp.GetString, Optional booTranspose As Boolean = False)
Dim sInhalt$
Dim F%
Dim varTemp
Dim n&
If Dir(sPath, vbNormal) = "" Then Exit Function
If FromLine > ToLine Then Exit Function
FromLine = FromLine - 1
If FromLine < 0 Then FromLine = 0
ToLine = ToLine - 1
If ToLine < 0 Then ToLine = 0
F = FreeFile
Open sPath For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close
varTemp = Split(sInhalt, LineBreak)
sInhalt = ""
If Ubound(varTemp) < FromLine Then Exit Function
If Ubound(varTemp) < ToLine Then ToLine = Ubound(varTemp)
For n = FromLine To ToLine - 1
ReadFile = ReadFile & varTemp(n) & LineBreak
Next
ReadFile = ReadFile & varTemp(ToLine)
If GetTyp = GetString Then
Exit Function
Else
varTemp = Split(ReadFile, LineBreak)
If booTranspose Then varTemp = ArrayTranspose(varTemp)
ReadFile = varTemp
End If
End Function
Private Function ArrayTranspose(varArray)
Dim NewArray()
Dim nRowCount&, nColCount&, nRow&, nCol&
If Not IsArray(varArray) Then
Exit Function
End If
On Error Resume Next
Redim NewArray( _
1 To Ubound(varArray, 2) - Lbound(varArray, 2) + 1, _
1 To Ubound(varArray) - Lbound(varArray) + 1)
If Err.Number = 0 Then
For nRow = Lbound(varArray) To Ubound(varArray)
nColCount = nColCount + 1
For nCol = Lbound(varArray, 2) To Ubound(varArray, 2)
nRowCount = nRowCount + 1
NewArray(nRowCount, nColCount) = varArray(nRow, nCol)
Next nCol
nRowCount = 0
Next nRow
Else
Redim NewArray( _
1 To Ubound(varArray) - Lbound(varArray) + 1, 1 To 1)
For nCol = Lbound(varArray) To Ubound(varArray)
nRowCount = nRowCount + 1
NewArray(nRowCount, 1) = varArray(nCol)
Next nCol
End If
ArrayTranspose = NewArray
End Function
Modul Modul1
Option Explicit
Sub Beipsiel()
Dim sPfad$
Dim varText
'Pfad zur Textdatei
sPfad = Application.GetOpenFilename("Files (*.*), *.*")
If sPfad = CStr(False) Then Exit Sub
'Pfad
'Von Zeile
'Bis Zeile
'Zeilenumbruch Zeichen
'Rückgabe String Or Array
'Transponiere Array
varText = ReadFile(sPfad, 15, 25, vbCr, GetString)
Debug.Print varText
End Sub
Gruß Tino