AW: html auslesen und in Excel speichern
06.03.2010 20:58:39
Josef
Hallo Friedemann,
das ist schon mal falsch 'strFind = "src=gender.female"',lass es bei 'strFind = "src=gender."'
Der Rest war mein Fehler.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub readData()
Dim strFile As String, strPath As String
Dim FF As Integer, intPos As Integer
Dim strValues() As String, strTmp As String
Dim strFind As String
strFind = "src=gender." 'Suchbegriff - Anpassen!
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
strPath = strPath & IIf(Right(strFile, 1) = "\", "", "\")
Redim strValues(1 To 2, 1 To 1)
strValues(1, 1) = "Datei"
strValues(2, 1) = "Geschlecht"
strFile = Dir(strPath & "*.htm*", vbNormal)
Do While strFile <> ""
strTmp = ""
FF = FreeFile
Open strPath & strFile For Input As #FF
Do While Not EOF(FF)
Line Input #FF, strTmp
intPos = InStr(1, strTmp, strFind)
If intPos > 0 Then
If Mid(strTmp, intPos + Len(strFind), 4) = "male" Then
strTmp = "M"
ElseIf Mid(strTmp, intPos + Len(strFind), 4) = "fema" Then
strTmp = "F"
End If
Exit Do
End If
Loop
Close #FF
Redim Preserve strValues(1 To 2, 1 To UBound(strValues, 2) + 1)
strValues(1, UBound(strValues, 2)) = strFile
strValues(2, UBound(strValues, 2)) = strTmp
strFile = Dir
Loop
Range("A1").Resize(UBound(strValues, 2), 2) = Application.Transpose(strValues)
Columns("A:B").AutoFit
End Sub
Gruß Sepp