Run out of memory
27.08.2004 11:31:57
Ryu_Hoshi
Weiss zufällig einer wie man das Problem lösen könnte? So sieht der code aus bis zu dem Punkt wo es abstürzt
Sub Auto_Open()
UserForm1.Show
Application.ScreenUpdating = False
Dim xPathAndFile As Variant
Dim xfn&
Dim xTxt$
Dim xA As Variant
Dim xB As Variant
Dim xi&
Dim xC As Variant
Dim xD As Variant
Dim wks As Worksheet
Dim xLastRow As Long
Dim rngX As Excel.Range
Dim wksE As Excel.Worksheet
'oder:
'xPathAndFile = ThisWorkbook.Path & "\" & "excel.ashx"
xPathAndFile = Application.GetOpenFilename("Files (*.ashx), *.ashx", Title:="File gesucht")
If xPathAndFile = False Then
MsgBox "Nichts ausgewählt!"
Exit Sub
End If
xfn = FreeFile
Open xPathAndFile For Binary As xfn
xTxt = Space(LOF(xfn))
Get xfn, 1, xTxt
Close xfn
'Zeilenunbrüche zur unterscheidung von Spaltenumbrüchen umbenennen
xTxt = Replace(xTxt, vbCrLf, Chr(0), 1, -1, 0)
'Umbrüche in den Zellen entfernen
xTxt = Replace(xTxt, vbCr, " ", 1, -1, 0)
'alle <td> durch Tab ersetzen
xTxt = Replace(xTxt, "<td>", vbTab, 1, -1, 1)
'Alle Html Tags entfernen
xTxt = Replace(xTxt, "<table>", "", 1, -1, 1)
xTxt = Replace(xTxt, "</table>", "", 1, -1, 1)
xTxt = Replace(xTxt, "</td>", "", 1, -1, 1)
xTxt = Replace(xTxt, "<tr>", "", 1, -1, 1)
xTxt = Replace(xTxt, "</tr>", "", 1, -1, 1)
xTxt = Replace(xTxt, "<b>", "", 1, -1, 1)
xTxt = Replace(xTxt, "</b>", "", 1, -1, 1)
xTxt = Replace(xTxt, "<br/>", "", 1, -1, 1)
Do While InStr(1, xTxt, "<", 1)
xTxt = Left(xTxt, InStr(1, xTxt, "<", 1) - 1) & Mid(xTxt, InStr(1, xTxt, ">", 1) + 1)
Loop
bei der Do While schleife, vorletzte Zeile stürzt es ab