Office: Probleme Laufzeitfehler 1004

allo,

ich habe ein kleines Problem.

Wenn ich an meinem Rechner eine Auswertung erstellen lasse, dann klappt alles. An einem Rechner, wo diese Auswertung auch erstellt werden soll bekomme ich aber die Meldung:

Laufzeitfehler '1004':
Die Methode 'Add' für das Objekt 'Workbooks' ist fehlegschlagen.

Woran kann das liegen? Kann es an der Menge liegen, die ist schon relativ hoch. Oder am Rechner?

Mfg
Harry

 

Hallo Harry,

man könnte vermuten es liegt am Code. Nur wenige sehen Deine Datei.

Gruß hajo

 

Wie meinst du das, dass nur wenige meine Datei sehen?

 

Hallo Harry,

ich schaue z.b. nicht über das Internet auf fremde Rechner. Also sehe ich Deine Datei nicht. Das kann bei einem anderem schon ganz anders aussehen.

Gruß Hajo

 

Abgesehen davon, ob jemand die Datei einsieht oder nicht, denke ich nicht, dass es am Code liegt, da es an einem Rechner klappt, an anderen nicht...

 

Kann es auch am "Alter" des Rechners liegen??
Office 2010 läuft bei beiden...

 

Hallo Harry,

Denken ist Glückssache. Entweder Du zeigst den Code, mit dem Fehler, oder Du musst damit leben.

Gruß


Edgar

 

Code:

Option Explicit

Private Sub cmdAuswerten_Click()
Dim shB As Worksheet
Dim shD As Worksheet
Dim lgAnzZeilen As Long         ' Maximale Zeile im Sheet Datenbasis
Dim iAnzSpalten As Integer      ' Maximale Spalte im Sheet Datenbasis
Dim rgSort As Range             ' Zu sortierender Bereich im Sheet Datenbasis (mit Ãœberschrift)
Dim rgSortSp As Range           ' Nach dieser Spalte wird sortiert
Dim lgLZeilProjekte As Long     ' Letzte Zeile der aufbereiteten Projekt-Auflistung
Dim iSpProjekte As Integer      ' Spalte, in der alle Projekte stehen
Dim x As Long

Dim xlAppl As Excel.Application
Dim fs As Object
Dim strVerz As String
Dim strDatei As String
Dim wbProjekt As Workbook

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set shB = Sheets("Bedienung")
Set shD = Sheets("Datenbasis")

' ***** Datenbasis nach Projekten sortieren *****
With shD
    lgAnzZeilen = .UsedRange.Rows.Count
    iAnzSpalten = .UsedRange.Columns.Count
    Set rgSort = .Range(.Cells(1, 1), .Cells(lgAnzZeilen, iAnzSpalten))   ' Sortierbereich mit Ãœberschrift
    Set rgSortSp = .Range(.Cells(1, 1), .Cells(lgAnzZeilen, 1))           ' zu sortierende Spalte
    
    ' eigentlicher Sortiervorgang
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=rgSortSp, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange rgSort       ' Sortierbereich ohne Ãœberschrift
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Nach dem Sortiervorgang das Blatt kurz auswählen und die Zelle A1 markieren
    .Select
    .Range("A1").Select
    shB.Select
End With

' ***** Die Daten auf dem Sheet "Datenbasis" sind jetzt nach Projekt sortiert. *****

' ***** Prüfen, ob das angegebene Verzeichnis existiert *****
Set xlAppl = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")

With shB.Cells(2, 1)
    strVerz = .Value
    If InStr(1, strVerz, "\") > 0 Then
        If fs.folderexists(strVerz) = False Then
            .Select
            MsgBox "Das in der markierten Zelle angegebene Dateiverzeichnis " & vbCrLf & _
                Chr(34) & strVerz & Chr(34) & vbCrLf & vbCrLf & _
                "existiert nicht. Bitte korrigieren Sie dies und versuchen Sie es anschließend erneut.", _
                vbCritical, "Verzeichnis nicht gefunden!"
            Exit Sub
        End If
    Else
        .Select
        MsgBox "Der in der markierten Zelle angegebene Pfadname " & vbCrLf & _
            Chr(34) & strVerz & Chr(34) & vbCrLf & vbCrLf & _
            "ist nicht korrekt, da er kein Zeichen '\' (Backslash) enthält. Bitte korrigieren Sie dies und versuchen Sie es anschließend erneut.", _
            vbCritical, "Pfad nicht korrekt!"
        Exit Sub
    End If
    
    ' Verzeichnis existiert, ggf. Backslash noch anfügen ...
    If Right(strVerz, 1) <Then> 1 Then
        .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Delete
    End If
End With

With shQ
    Set rgFund = .Columns(iErstSp).Find(what:=strProjekt, LookIn:=xlValues, lookat:=xlWhole)
    lgErstZeil = rgFund.Row
    
    lgLetztZeil = lgErstZeil
    
    Do While .Cells(lgLetztZeil + 1, iErstSp) = rgFund
        lgLetztZeil = lgLetztZeil + 1
    Loop
    
    .Range(.Cells(lgErstZeil, iErstSp), .Cells(lgLetztZeil, iAnzSpalten)).Copy
End With

With shZ
    .Cells(2, 1).Select
    .Paste
    .Cells(1, 1).Select
End With

wbProjekt.Close True
End Sub

 

Hallo,

mein Debugger meckert hier:

Code:

.Sort.SortFields.Clear

Das ist auch kein gültiger Ausdruck:

Code:

If Right(strVerz, 1) <Then> 1 Then 

Undefinierte Variablen: shQ, strProjekt, iErstSp, rgFund, lgErstZeil, lgLetztZeil, shZ

Weiterhin könnte dieser Ausdruck:

Code:

Set fs = CreateObject("Scripting.FileSystemObject")

auf einem anderen Rechner einen Fehler verursachen. s. auch hier: http://www.xlam.ch/soscq/vbafilesystemobject.htm

Gruß

Edgar

 

Habe ich versucht, klappt nicht...

Harry

 

Hallo,

Was hast Du versucht,
was klappt nicht??

Gruß

Edgar