Laufzeitfehler 13
12.02.2013 14:39:26
Stephan
Ich hab eine Mastertabelle erstellt in diese sollen verschiede Informationen aus web optimierten *.HTML Dateien einfließen (wie zB. Ort, PLZ ....)
Ich habe nun die erste Datei genommen und per Aufzeichnung eingefügt funktioniert alles super und sieht so aus
Sub Einlesen()
' Einlesen Makro
ChDir "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages"
Workbooks.Open Filename:= _
"D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\7.html"
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows("7.html").Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows("7.html").Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows("7.html").Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").Select
ActiveSheet.Paste
Range("I3").Select
Windows("7.html").Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows("7.html").Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").Select
ActiveSheet.Paste
Windows("7.html").Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").Select
ActiveSheet.Paste
Windows("7.html").Activate
ActiveWindow.Close savechanges:=False
End Sub
nun kommt das komplexere in dem Ordner Pages sind 1206 Datensätze die ich so per Schleife einbinden will.
Diese Daten hab ich per FSO in List1 gesammelt und will sie nun per FOR NEXT Schleife einbauen.
Sah dann erstmal so aus
Public oFSO As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim List1 As New Collection
Sub Einlesen()
Dim i As Integer
Dim dummy As String
' Einlesen Makro
Set oFolder = oFSO.GetFolder("D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\")
For Each oFile In oFolder.Files
List1.Add oFile
Next
For i = 1 To List1.Count
ChDir "D:\Abraham\Projekte\Frühförderung\Rohdaten\pages\"
Workbooks.Open Filename:=List1(i)
Range("B4:C4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows(List1(i)).Activate
Cells.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Range("B4").Select
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Windows(List1(i)).Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("E5").Select
Windows("Datenbank2.xlsm").Activate
Range("E3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("F3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("G3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("H3").Select
ActiveSheet.Paste
Range("I3").Select
Windows(List1(i)).Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("J3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("K3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("L3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Datenbank2.xlsm").Activate
Range("M3").Select
ActiveSheet.Paste
Windows(List1(i)).Activate
ActiveWindow.Close savechanges:=False
Next
End Sub
nun sehe ich noch das die erste Datei die aufgemacht wird 10.html ist aber ersagt dann auch gleich oben Laufzeitfehler 13.
Per Dummy - String (den man oben noch etwas sieht) konnte ich sehen das der Pfad der richtige ist und 10.html öffnet sich auch also wo ist nun das Problem? denn bis zum Kopieren kommt er nicht