Office: Probleme beim oeffnen eines Workbooks

Hallo alle miteinander,

Habe ein Problem mit meinem zusammengeschusterten Programm. Und zwar funktioniert es hervorragend auf meinem PC. Auch als Add-In. Jedoch leider nicht bei meinem Kollegen, fuer den dieses Makto eigentlich ist...die Fehlerzeile habe ich separat in einen Codeblock gestellt, da man hier leider weder Zeilennummer hat noch markieren kann. Excel springt dabei mit "...out of range" raus. Nun frage ich mich, was ich da nicht beachtet habe. Koennt ihr mir bitte helfen?

Die Fehlerzeile(relativ weit oben)

Code:

'Last row in column A in actual workbook 
    With workbooks("wb").Worksheets("wb")

Der ganze Code:

Code:

Sub Compare_sheets_and_send_by_email()
    
    Dim LoI As Long                                             ' 1st loop variable
    Dim LoJ As Long                                             ' 2nd loop variable
    Dim LoX As Long                                             ' 3rd loop variable
    Dim LoY As Long                                             ' 4th loop variable
    Dim LoLetzte1 As Long                                       ' Variable last row in column A actual workbook
    Dim LoLetzte2 As Long                                       ' Variable last row in column A "managed" workbook ref
    Dim Loletzte3 As Long                                       ' Variable last row in column A "unmanaged" workbook ref
    Dim strPfad As String                                       ' Variable absolute path
    
    Dim iMsg As Object
    Dim iMsg2 As Object
    Dim iConf As Object                                         ' Variable for email
    Dim strbody As String                                       ' Text for email
    Dim Flds As Variant                                         ' needed for SMTP mailtransport
    

    Dim cell As Range
    Dim sendto As String                                        ' Variable email recipient
    
    Dim Sourcewb As Workbook                                    ' Sourceworkbook
    Dim Destwb As Workbook                                      ' Destinationworkbook

    Dim TempFilePath As String                                  ' Temppath for tempfile to send
    Dim TempFileName_Managed As String                          ' Tempfilename Managed Sheet
    Dim TempFileName_Unmanaged As String                        ' Tempfilename Unmanaged Sheet
    
    strPfad = ActiveWorkbook.Path                               ' Damit ref.xls relativ angesprochen werden kann
    TempFilePath = Environ$("temp") & "\"                       ' Set temp path
    Application.ScreenUpdating = False                          ' Bildschirmaktualisierung aus
    
    
    Application.DisplayAlerts = False                           'If file already exists, don't display warning
    ActiveWorkbook.SaveAs TempFilePath & "wb.xls"
    Application.DisplayAlerts = True
    
    ActiveSheet.Name = "wb"
    
'Last row in column A in actual workbook
    With workbooks("wb").Worksheets("wb")
        LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, .Rows.Count)
    End With
    
    Workbooks.Open Filename:=strPfad & "\" & "ref.xls"          ' Opens ref workbook
    
'Last row in column A "managed" workbook ref
   With Workbooks("ref").Worksheets("ref")        LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, .Rows.Count)
    End With
    
'Last row in column B "unmanaged" workbook ref
    With Workbooks("ref").Worksheets("ref")
        Loletzte3 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
    End With

Range("A1", Cells(LoLetzte1, 7)).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'------------------------Managed----------------------------------------
    Workbooks("wb").Activate
    Sheets.Add.Name = "MSUK INV_MANAGED_" & Format(Now, "ddmmyy")
    For LoI = 1 To LoLetzte1                                                ' 1st outer loop all values column A
        For LoJ = 1 To LoLetzte2                                            ' 2nd inner loop all values column A managed
            If Worksheets("wb").Cells(LoI, 1) <> "" Then                    ' ignore blank lines
                
                If Worksheets("wb").Cells(LoI, 1) = Workbooks("ref").Worksheets("ref").Cells(LoJ, 1) Then
                    Worksheets("wb").Rows(LoI).Copy         ' cell is equal, copy cell
                    
                    With Worksheets("MSUK INV_MANAGED_" & Format(Now, "ddmmyy"))
                        .Rows(LoJ).PasteSpecial Paste:=xlValues             ' transfer value
                        '.Rows(Loletzte4).PasteSpecial Paste:=xlFormats     ' tranfer format
                        .Cells(LoJ, 7).Value = "MANAGED"
                    End With
                  
                    
                    Exit For                                                ' Exit 2nd inner loop as data found
                End If

            End If
        Next LoJ
    Next LoI

With Worksheets("MSUK INV_MANAGED_" & Format(Now, "ddmmyy"))
    .Cells(1, 7).Value = "ISMANAGED"
End With

Worksheets("MSUK INV_MANAGED_" & Format(Now, "ddmmyy")).Range("A1", Cells(LoLetzte2 + 1, 7)).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'-------------------------------------------------------------------------

'-------------------------Unmanaged---------------------------------------
    Sheets.Add.Name = "MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy")
    For LoY = 1 To LoLetzte1                                                  ' 1st outer loop all values column A
            For LoX = 1 To Loletzte3                                          ' 2nd inner loop all values column A unmanaged
             If Worksheets("wb").Cells(LoY, 1) <> "" Then                    ' ignore blank lines
                
                If Worksheets("wb").Cells(LoY, 1) = Workbooks("ref").Worksheets("ref").Cells(LoX, 2) Then
                    Worksheets("wb").Rows(LoY).Copy                           ' Zellen sind gleich, Zeile Kopieren
                    
                    With Worksheets("MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy"))
                        ' letzte belegte Zeile in Tabelle3 ermitteln
                        'LoLetzte5 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        .Rows(LoX).PasteSpecial Paste:=xlValues               ' transfer value
                        '.Rows(Loletzte5).PasteSpecial Paste:=xlFormats       ' transfer format
                        .Cells(LoX, 7).Value = "UNMANAGED"
                    End With
                    
                    Exit For                                                  ' Exit 2nd inner loop as data found
                End If
                
             End If
        Next LoX
    Next LoY
    
With Worksheets("MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy"))
    .Cells(1, 7).Value = "ISMANAGED"
End With

Worksheets("MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy")).Range("A1", Cells(Loletzte3 + 1, 7)).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'--------------------------------------------------------------------------

    Application.CutCopyMode = False                                           ' Zwischenspeicher löschen
    Application.ScreenUpdating = True                                         ' Bildschirmaktualisierung ein
    
'Copy Sheets and prepare to send for Managed
    Set Sourcewb = ActiveWorkbook
    Sourcewb.Sheets(Array("MSUK INV_MANAGED_" & Format(Now, "ddmmyy"))).Copy
    Set Destwb = ActiveWorkbook
    
    '!!!
    'Filename .xls
    TempFileName_Managed = "MSUK INV_MANAGED_" & Format(Now, "ddmmyy")
    '!!!
    With Destwb
        .SaveAs TempFilePath & TempFileName_Managed & ".csv", FileFormat:=6
        .Close savechanges:=False
    End With
'Copy Sheets and prepare to send for Unmanged
    Set Sourcewb = ActiveWorkbook
    Sourcewb.Sheets(Array("MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy"))).Copy
    Set Destwb = ActiveWorkbook
    
    '!!!
    'Filename .xls
    TempFileName_Unmanaged = "MSUK INV_UNMANAGED_" & Format(Now, "ddmmyy")
    '!!!
    With Destwb
        .SaveAs TempFilePath & TempFileName_Unmanaged & ".csv", FileFormat:=6
        .Close savechanges:=False
    End With

Application.ScreenUpdating = False                           ' Bildschirmaktualisierung aus

'Collecting the email addresses
    On Error Resume Next
    For Each cell In Workbooks("ref").Sheets("email-address").Range("B1:B10").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
            sendto = sendto & cell.Value & ";"
        End If
    Next cell
    On Error GoTo 0
    If Len(sendto) > 0 Then sendto = Left(sendto, Len(sendto) - 1)
'Ende collecting

    Set iMsg = CreateObject("CDO.Message")
    Set iMsg2 = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

'Start Workaround - Necessary, if there is no account in OutlookExpress or WindowsMail on local machine
        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "dove.examp.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
'End Workaround

    With iMsg
        Set .Configuration = iConf
        .To = sendto
        .CC = ""
        .BCC = ""
        .From = """Tol"" <tol>"
        .Subject = "MSUK INV Managed"
        .TextBody = ""
        .AddAttachment TempFilePath & TempFileName_Managed & ".csv"
        .Send
    End With
    
        With iMsg2
        Set .Configuration = iConf
        .To = sendto
        .CC = ""
        .BCC = ""
        .From = """Tol"" <tol>"
        .Subject = "MSUK INV Unmanaged"
        .TextBody = ""
        .AddAttachment TempFilePath & TempFileName_Unmanaged & ".csv"
        .Send
    End With
    
'Delete the files you have sent
    Warnung = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Kill TempFilePath & TempFileName_Managed & ".csv"
    Kill TempFilePath & TempFileName_Unmanaged & ".csv"
    Workbooks("wb").Close
    Workbooks("ref").Close
    Kill TempFilePath & "wb" & ".xls"
    Application.DisplayAlerts = Warnung
 

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

Fehler ist nun bekannt.....ich habe die Endung beim oeffnen des jeweiligen Workbooks nicht beachtet, sodass bei PCs mit eingeblendeter Endung das Workbook nicht gefunden werden konnte. Bei allen Anweisungen nun eine Endung drangeschrieben und voila....es ging!