AW: Textdatei auslesen
05.08.2011 10:08:36
Tino
Hallo,
kannst mal diesen Code testen, den Ordner kannst Du über einen Dialog auswählen.
kommt als Code in Modul1
Option Explicit
Public Sub Start()
Dim strFolder As String
Dim lngFileCount As Long
Dim ArrayFile(), ArFileFilter()
Dim F As Integer, sLine As String
Dim ArrayTextInhalt()
With Tabelle1
'Tabelle leer machen für neue Daten
.Range("A2", .Cells(.Rows.Count, 1)).ClearContents
ArFileFilter = Array("*.txt") 'Filter für die Suche
strFolder = OrdnerAuswahl("C:\")
If strFolder <> "" Then
strFolder = IIf(Right$(strFolder, 1) = "\", strFolder, strFolder & "\")
FindFiles ArrayFile, strFolder, lngFileCount, ArFileFilter, False
End If
If lngFileCount > 0 Then
' 'Pfad + Dateiname in Zelle schreiben, evtl. aktivieren
' .Range("A2").Resize(lngFileCount, 1) = Application.Transpose(ArrayFile)
Redim ArrayTextInhalt(1 To lngFileCount, 1 To 1)
F = FreeFile
For lngFileCount = Lbound(ArrayFile) To Ubound(ArrayFile)
Open ArrayFile(lngFileCount) For Input As #F
While Not EOF(F) And sLine = ""
Line Input #F, sLine
ArrayTextInhalt(lngFileCount, 1) = sLine
Wend
sLine = ""
Close #F
Next lngFileCount
'Inhalt aus Textdatei (1. Zeile) ab B2 einfügen
.Range("B2").Resize(lngFileCount, 1) = ArrayTextInhalt
End If
End With
End Sub
kommt als Code in Modul2
Option Private Module
Option Explicit
'Teile des Originalcode von Nepumuk. ******************************************
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
ByVal hFindFile As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1&
Private Const MAX_PATH = 260&
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Enum FILE_ATTRIBUTE
FILE_ATTRIBUTE_READONLY = &H1
FILE_ATTRIBUTE_HIDDEN = &H2
FILE_ATTRIBUTE_SYSTEM = &H4
FILE_ATTRIBUTE_DIRECTORY = &H10
FILE_ATTRIBUTE_ARCHIVE = &H20
FILE_ATTRIBUTE_NORMAL = &H80
FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'Ordner Dialog
Public Function OrdnerAuswahl(Optional ByVal sPath As String = "C:\")
Dim strOrdner As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sPath
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
OrdnerAuswahl = strOrdner
End Function
Sub FindFiles(ArrayData(), ByVal strFolderPath As String, _
ByRef lngFileCount As Long, ArFileFilter, Optional SubFolder As Boolean = True)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
GetFilesInFolder ArrayData, strFolderPath, lngFileCount, ArFileFilter
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
If SubFolder = False Then Exit Sub 'ohne Unterordner
If (strDirName <> ".") And (strDirName <> "..") Then _
FindFiles ArrayData, strFolderPath & strDirName & "\", lngFileCount, ArFileFilter
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
End Sub
Sub GetFilesInFolder(ArrayData(), ByVal strFolderPath As String, _
ByRef lngFileCount As Long, ArFileFilter)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFileName As String
Dim FileFilter
For Each FileFilter In ArFileFilter
lngSearch = FindFirstFile(strFolderPath & FileFilter, WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> _
FILE_ATTRIBUTE_DIRECTORY Then
strFileName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
Redim Preserve ArrayData(lngFileCount)
ArrayData(lngFileCount) = strFolderPath & strFileName
lngFileCount = lngFileCount + 1
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
Next
End Sub
Gruß Tino