Probleme beim oeffnen eines Workbooks :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

[Excel 2003] Probleme beim oeffnen eines Workbooks

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

Schiggi
Newbie
Newbie

Anmeldedatum: 01.09.2008
Beiträge: 2

Verfasst am: 01.09.2008, 16:15

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

Schiggi
Newbie
Newbie

Anmeldedatum: 01.09.2008
Beiträge: 2

Verfasst am: 01.09.2008, 18:08

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!

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Probleme mit Textfelder	chaplin	Microsoft Word Hilfe	0	04.01.2009, 13:31
	Probleme mit Hoverschaltfläche	gerd.ringelmann	Microsoft FrontPage Hilfe	0	04.01.2009, 10:05
	Beim speichern von Anlagen werden Ord...	trottlbua	Microsoft Outlook Hilfe	0	25.12.2008, 00:33
	Probleme beim Seriendruck von Etiketten	elfriedequack	Microsoft Word Hilfe	9	18.12.2008, 11:10
	Problem beim einfügen von Buchstaben	Napgamer	Microsoft Word Hilfe	2	14.12.2008, 18:06

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de