Computerwissen Club

Ich habe aus einer Buchführung einen Teil ausgedruckt. Nun komme ich weder an die Datei, die noch besteht und unter Druckvorschau zu sehen ist, nicht mehr heran. Dasselbe gilt für andere Excel-Dateien. Keine läßt sich mehr allgemein öffnen. Was kann ich tun bei Excel 2003?

Munteres Moin moin in die Runde, Ich hatte mir von der Seite des Computerwissen Clubs die Excel-Datei „Termin Export.xla“ heruntergeladen, um Bereiche des Outlook-Kalenders in eine Exceltabelle zu exportieren. Leider scheint diese Datei nur für 32 bit Systeme ausgelegt zu sein, denn ich erhalte jedes Mal beim Öffnen folgende Fehlermeldung: „Fehler beim Kombilieren: Der Code in diesem Projekt muss für die Verwendung auf 64-bit Systemen aktualisiert werden. Überarbeiten und aktualisieren Sie Declare-Anweisungen, und markieren Sie sie mit dem Ptrsafe Attribut.“ Leider für mich nur Kauderwelsch. Falls mir jmd. helfen könnte wäre ich sehr dankbar. In Verwendung: Outlook 2013 Windows 7 64 bit beste Grüße und herzlichen Dank vorab. Stephan Hier der Quelltext: ´ ´(C) Martin Althaus 2004 ´ Declare Function GetWindowsDirectoryA Lib „KERNEL32“ (ByVal Puffer As String, ByVal groesse As Integer) As Integer Declare Function GetWindowsDirectory Lib „KERNEL32“ (ByVal Puffer As String, ByVal groesse As Integer) As Integer Private Declare Function ShellExecute Lib „shell32.dll“ Alias „ShellExecuteA“ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Type PfadTyp hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Declare Function SHGetPathFromIDList Lib „shell32.dll“ Alias „SHGetPathFromIDListA“ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib „shell32.dll“ Alias „SHBrowseForFolderA“ (lpBrowseInfo As PfadTyp) As Long Public Declare Function FindFirstFile Lib „KERNEL32“ Alias „FindFirstFileA“ _ (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Public Declare Function FileTimeToSystemTime Lib „KERNEL32“ _ (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long Declare Function FileTimeToLocalFileTime Lib „KERNEL32“ _ (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Long End Type Public Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 260 cAlternate As String * 14 End Type Sub WebSiteAufrufen(Url As String) On Error Resume Next ShellExecute 0&, vbNullString, Url, vbNullString, vbNullString, vbNormalFocus On Error GoTo 0 End Sub Function WaehleVerzeichnis(Optional Meldung) As String On Error Resume Next Dim bInfo As PfadTyp Dim path As String Dim r As Long, x As Long, pos As Integer bInfo.pidlRoot = 0& If IsMissing(Meldung) Then bInfo.lpszTitle = „Wählen Sie einen Archivierungspfad:“ Else bInfo.lpszTitle = Meldung End If bInfo.ulFlags = &H1 x = SHBrowseForFolder(bInfo) path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) WaehleVerzeichnis = Left(path, pos – 1) Else WaehleVerzeichnis = „“ End If On Error GoTo 0 End Function Sub auto_open() On Error Resume Next MenuBars(xlWorksheet).Menus(4).MenuItems.Add OnAction:=“TermineEinfuegen“, Caption:=“Outlook-&Termine als Liste importieren“ On Error GoTo 0 End Sub Sub auto_close() On Error Resume Next MenuBars(xlWorksheet).Menus(4).MenuItems(„Outlook-Termine als Liste importieren“).Delete On Error GoTo 0 End Sub Sub TermineEinfuegen() On Error Resume Next UserForm1.Label7.Caption = „Startdatum für den Import: (nicht festgelegt)“ UserForm1.Label8.Caption = „Enddatum für den Import: (nicht festgelegt)“ UserForm1.Show On Error GoTo 0 End Sub Sub Lesen() On Error Resume Next Dim oOL As Object Dim myitem As Object Dim oEntry As Object Dim iCounter, startzeile, anzahl, canzahl, i, j, tzaehler As Integer Dim datum, betreff, ort, beginn, ende, ganztaegigeinaus, erinnerungeinaus, erinnerungszeitpunkt, importieren As Boolean Dim bln, zesp As Boolean Dim Bereich As Range Dim tw, tw2, ne As Worksheet ´UserForm1.Hide bln = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.ScreenUpdating = False Set oOL = CreateObject(„Outlook.Application“) Set tw = ThisWorkbook.Worksheets(1) If UserForm1.OptionButton1 = True Then Set ne = ActiveWorkbook.Worksheets.Add Else Set ne = Workbooks.Add.Worksheets(1) End If i = 1 With UserForm1 If .CheckBox1 = True Then datum = True ne.Cells(1, i).Formula = „Datum“ i = i + 1 Else datum = False End If If .CheckBox4 = True Then betreff = True ne.Cells(1, i).Formula = „Betreff“ i = i + 1 Else betreff = False End If If .CheckBox5 = True Then ort = True ne.Cells(1, i).Formula = „Ort“ i = i + 1 Else ort = False End If If .CheckBox7 = True Then beginn = True ne.Cells(1, i).Formula = „Beginn“ i = i + 1 Else beginn = False End If If .CheckBox6 = True Then ende = True ne.Cells(1, i).Formula = „Ende“ i = i + 1 Else ende = False End If If .CheckBox8 = True Then ganztaegigeinaus = True ne.Cells(1, i).Formula = „Ganztägig Ein/Aus“ i = i + 1 Else ganztaegigeinaus = False End If If .CheckBox3 = True Then erinnerungeinaus = True ne.Cells(1, i).Formula = „Erinnerung Ein/Aus“ i = i + 1 Else erinnerungeinaus = False End If If .CheckBox2 = True Then erinnerungszeitpunkt = True ne.Cells(1, i).Formula = „Erinnerungszeitpunkt“ i = i + 1 Else erinnerungszeitpunkt = False End If End With With ThisWorkbook.Worksheets(1) .Range(„e16“).Formula = UserForm1.Label7.Caption .Range(„e17“).Formula = UserForm1.Label8.Caption End With Set myNamespace = oOL.GetNamespace(„MAPI“) Set mytermine = myNamespace.GetDefaultFolder(9).items ´olfoldercalendar canzahl = mytermine.Count i = 2 For j = 1 To canzahl ThisWorkbook.Worksheets(1).Range(„a1“) = mytermine(j).Start If ThisWorkbook.Worksheets(1).Range(„e8“).Value = True Then ´Termin liegt im Bereich? importieren = False If UserForm1.OptionButton10 = True Then importieren = True If (UserForm1.OptionButton7 = True) And (mytermine(j).reminderset = True) Then importieren = True If (UserForm1.OptionButton8 = True) And (mytermine(j).reminderset = False) Then importieren = True If importieren = True Then importieren = False If UserForm1.OptionButton9 = True Then importieren = True If (UserForm1.OptionButton5 = True) And (mytermine(j).alldayevent = True) Then importieren = True If (UserForm1.OptionButton6 = True) And (mytermine(j).alldayevent = False) Then importieren = True End If If importieren Then k = 1 If datum Then ne.Cells(i, k).Formula = tw.Range(„a4“).Value k = k + 1 End If If betreff Then ne.Cells(i, k).Formula = mytermine(j).Subject k = k + 1 End If If ort Then If mytermine(j).Location = „“ Then ne.Cells(i, k).Formula = „(kein)“ Else ne.Cells(i, k).Formula = mytermine(j).Location End If k = k + 1 End If If beginn Then ne.Cells(i, k).Formula = tw.Range(„a5“).Text k = k + 1 End If If ende Then tw.Range(„e10“).Value = mytermine(j).Duration ne.Cells(i, k).Formula = tw.Range(„e12“).Text k = k + 1 End If If ganztaegigeinaus Then ne.Cells(i, k).Formula = mytermine(j).alldayevent k = k + 1 End If If erinnerungeinaus Then ne.Cells(i, k).Formula = mytermine(j).reminderset k = k + 1 End If If erinnerungszeitpunkt Then If mytermine(j).reminderset = True Then tw.Range(„e10“).Value = mytermine(j).reminderminutesbeforestart ne.Cells(i, k).Formula = tw.Range(„e13“).Text End If k = k + 1 End If i = i + 1 End If End If Next j ne.Cells(1, 1).EntireRow.Font.Bold = True ne.Activate ne.Range(„a1“).Select Selection.AutoFilter For j = 1 To k – 1 ne.Cells(1, j).EntireColumn.AutoFit Next j ne.Range(Cells(1, 1), Cells(i – 1)).Sort Key1:=Range(„A2“), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Set oOL = Nothing Application.StatusBar = False Application.DisplayStatusBar = bln Application.ScreenUpdating = True ´ UserForm1.Hide On Error GoTo 0 End Sub