form open Fehler 438

[peterchen1000]

Hilfe !!!!!! Dringend

Nach Umstellung auf Win 7 64 Bit bekomme ich beim Öffnen eines Access Formulars
eine Fehlermeldung Fehler Scan_Form form_open Fehler 438. Kann mir jemand helfen?
Ich benutze Office 2007.

Formular hat folgenden VBACode:

' hier gehts los...
' #################
Private Sub Form_Open(Cancel As Integer)

' falls kein Dateiname übergeben wurde...
    myFileName = "C:\__SCAN__.tif"
    Me.lbDokumentname.Caption = " " & myFileName

    On Error GoTo Err_Form_Open

    myError = 0
    bScanDialog = False

    If UCase(GetSystemValue("ScanDirect")) = "TRUE" Then
        Me.chkOhneScanDialog = True
    Else
        Me.chkOhneScanDialog = False
    End If

    ' Scannertreiber vorhanden?
    If Me.CtlScan.ScannerAvailable = True Then
        Me.lbScanner.Caption = fGetScannerName()
    Else
        Me.lbScanner.Caption = "kein Scanner vorhanden"
        Me.lbScanner.BackColor = vbRed
        Me.btScanNew.Enabled = False
        Me.btScannerEinst.Enabled = False
        Me.btScannerSelect.Enabled = False
    End If

    ' Operation und Filename übernehmen
    If Len(Me.OpenArgs) > 0 Then
        myOperation = CInt(Left(Me.OpenArgs, 1))
        myFileName = Mid(Me.OpenArgs, 2)
        Me.lbDokumentname.Caption = " " & myFileName
        lbZoom.Caption = ""

        ' Operation auswählen
        Select Case myOperation
                ' vorhandenes Dokument anzeigen
            Case DOC_EDIT
                CtlAdmin.Image = myFileName

                With CtlPreview
                    .Image = myFileName
                    .DisplayThumbs
                    .ThumbSelected(1) = True
                End With

                With CtlEdit
                    .Image = myFileName
                    .Page = 1
                    .FitTo 1    ' wiFIT_TO_WIDTH
                    .Display
                End With
        End Select
    End If


Exit_Form_Open:
    Exit Sub

Err_Form_Open:
    MsgBox "Fehler in frm_Scan: Form_Open" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
    Resume Exit_Form_Open

End Sub

' Dokument ausdrucken
Private Sub btPrint_Click()
    On Error GoTo Err_btPrint_Click


    ' Druckdialog des Admin-Controls anzeigen
    CtlAdmin.CancelError = True
    CtlAdmin.PrintNumCopies = 1
    CtlAdmin.Image = CtlEdit.Image
    CtlAdmin.ShowPrintDialog Me.hWnd

    'drucken der Datei, die Werte aus dem Druckerdialog werden als Parameter übergeben
    CtlEdit.PrintImage CtlAdmin.PrintStartPage, CtlAdmin.PrintEndPage, _
                       CtlAdmin.PrintOutputFormat, CtlAdmin.PrintAnnotations

Exit_btPrint_Click:
    Exit Sub

Err_btPrint_Click:
    Select Case err.Number
        Case 32755  ' Abbruch...
        Case 53     ' kein Bild zum Drucken vorhanden
        Case Else
            MsgBox "Fehler in frm_Scan: btPrint_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
    End Select
    Resume Exit_btPrint_Click

End Sub

' speichern des Dokuments
Private Sub btSave_Click()
    On Error Resume Next
    If CtlEdit.Image <> "" Then
        CtlEdit.Save
    End If

End Sub

' hier passiert das Scannen
Private Sub btScanNew_Click()
    Dim iTmb   As Integer
    Dim lScanError As Long

    On Error GoTo Err_btScanNew_Click


    ' Scanner öffnen
    lScanError = CtlScan.OpenScanner
    ' hat's geklappt
    If lScanError <> 0 Then
        CtlScan.CloseScanner
        Exit Sub
    End If


    CtlScan.Image = myFileName
    CtlScan.Scroll = True

    ' keinen Scanner-Dialog anzeigen
    If chkOhneScanDialog Then
        With CtlScan
            .ShowSetupBeforeScan = False
            .FileType = 1    ' TIF
            .PageType = 7    ' 24-Bit-Farbtiefe
            .CompressionType = 6    ' JPEG-Kompression
        End With
    Else
        CtlScan.ShowSetupBeforeScan = True
    End If


    ' Scan einfügen?
    If chkInsertScan Then
        CtlScan.MultiPage = True

        If CtlPreview.ThumbCount > 0 Then
            '            CtlScan.PageOption = 3 'neuer Scann wird vor die markierte Seite gelegt
            ' Bild anfügen
            CtlScan.PageOption = 2
            CtlScan.Page = CtlPreview.ThumbCount + 1
        Else
            ' erstes Bild
            CtlScan.PageOption = 1
            CtlScan.Page = 1
        End If

        ' sonst eventuell altes Bild speichern und neu
    Else
        If CtlEdit.ImageModified Then SaveImage

        CtlEdit.ClearDisplay
        CtlEdit.Image = ""

        CtlPreview.Image = ""
        For iTmb = 1 To CtlPreview.ThumbCount Step 1
            CtlPreview.ClearThumbs iTmb
        Next iTmb
        CtlPreview.Refresh

        CtlScan.MultiPage = False
        CtlScan.PageOption = 1
        CtlScan.Page = 1
    End If

    ' hier scannen
    CtlScan.ResetScanner
    CtlScan.ScanTo = 2    ' nur Datei
    lScanError = CtlScan.StartScan

    ' Fehler aufgetreten?
    If lScanError <> 0 Then
        CtlScan.CloseScanner
        Exit Sub
    End If

    If CtlScan.Image <> "" Then
        CtlPreview.Image = CtlScan.Image
        CtlPreview.Requery
        CtlPreview.ThumbSelected(CtlPreview.ThumbCount) = True

        CtlEdit.Image = CtlScan.Image
        CtlEdit.FitTo 1    ' wiFIT_TO_WIDTH
        lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
        CtlEdit.Page = CtlPreview.ThumbCount
        CtlEdit.Display

    End If

    CtlScan.CloseScanner

Exit_btScanNew_Click:
    Exit Sub

Err_btScanNew_Click:
    Select Case err.Number
        Case 1101   ' Scanner nicht angeschlossen
        Case Else
            MsgBox "Fehler in frm_Scan: btScanNew_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
    End Select
    Resume Exit_btScanNew_Click

End Sub

' Programmende über Button
Private Sub Button_schliessen_Click()
    On Error GoTo Err_Button_schliessen_Click

    DoCmd.Close

Exit_Button_schliessen_Click:
    Exit Sub

Err_Button_schliessen_Click:
    MsgBox "Fehler in frm_Scan: Button_schliessen_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
    Resume Exit_Button_schliessen_Click

End Sub


' Vorschaubild auswählen
Private Sub CtlPreview_Click(ByVal ThumbNumber As Long)
    Dim iCnt   As Integer

    On Error GoTo Err_CtlPreview_Click

    ' wenn Vorschaubilder vorhanden
    If ThumbNumber <> 0 Then
        ' gibt es Änderungen am aktuellen Dokument?
        If CtlEdit.ImageModified Then SaveImage

        For iCnt = 1 To CtlPreview.ThumbCount Step 1
            CtlPreview.ThumbSelected(iCnt) = False
        Next iCnt
        CtlPreview.ThumbSelected(ThumbNumber) = True
        CtlEdit.Page = ThumbNumber
        CtlEdit.Display
        lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
        ' gibt es noch weitere Dokumente?
        CheckNextPrevious
    End If


Exit_CtlPreview_Click:
    Exit Sub

Err_CtlPreview_Click:
    MsgBox "Fehler in frm_Scan: CtlPreview_Click" & vbCrLf & err.Number & ": " & err.Description, vbExclamation + vbOKOnly, "Fehler..."
    Resume Exit_CtlPreview_Click

End Sub

' Zoom-Faktor einstellen
Sub zoomen(faktor)
    On Error Resume Next

    If CtlEdit.Image <> "" Then
        If faktor > 6554 Then faktor = 6554    ' Grenze lt. Doku
        If faktor < 10 Then faktor = 10
        CtlEdit.Zoom = faktor
        lbZoom.Caption = CInt(CtlEdit.Zoom) & " %"
        CtlEdit.Refresh
    End If

End Sub

' Test ob weitere Dokumente vorhanden sind
Private Sub CheckNextPrevious()
' nur wenn überhaupt ein Dokument vorhanden
    If CtlEdit.Image <> "" Then
        ' wenn es nur ein Dokument gibt; Buttons deaktivieren
        If CtlEdit.PageCount = 1 Then
            btPrev.Enabled = False
            btNext.Enabled = False
            ' wenn es das letzte Dokument ist
        ElseIf CtlEdit.Page = CtlEdit.PageCount Then
            btPrev.Enabled = True
            btPrev.SetFocus
            btNext.Enabled = False
            ' wenn es das erste Dokument ist
        ElseIf CtlEdit.Page = 1 Then
            btNext.Enabled = True
            btNext.SetFocus
            btPrev.Enabled = False
            ' ... sonst Buttons aktivieren
        Else
            btPrev.Enabled = True
            btNext.Enabled = True
        End If
        ' sonst Buttons deaktivieren
    Else
        btPrev.Enabled = False
        btNext.Enabled = False
    End If

End Sub

' Bild speichern
Public Sub SaveImage()
    If MsgBox("Das aktuelle Bild wurde geändert. Wollen Sie die Änderungen speichern?", _
              vbQuestion + vbYesNo, "Änderung") = vbYes Then
        If CtlEdit.ImageModified = True Then CtlEdit.BurnInAnnotations 2, 2
        CtlEdit.Save
        CtlPreview.Image = CtlEdit.Image
        CtlPreview.Refresh
    End If
End Sub

' leider will die Toolbox immer in den Hintergrund ?!?
Sub ToolBoxInFront()
    Dim myTask As Long
    Dim Result As Long
    Dim TBhwnd As Long
    Dim hWnd   As Long


    ' eigene Task-Id ermitteln
    Result = GetWindowThreadProcessId(Me.hWnd, myTask)

    'Einstieg
    hWnd = GetWindow(Me.hWnd, GW_HWNDFIRST)

    'Alle vorhandenen Fenster abklappern
    Do
        If GetWindowInfo(hWnd, myTask) Then
            ' Toolbox immer im Vordergrund
            SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
            Exit Sub
        End If
        hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Loop Until hWnd = 0

End Sub

' wird gebraucht für Sub ToolBoxInFront()
Private Function GetWindowInfo(ByVal hWnd As Long, ByVal myTask As Long) As Boolean
    Dim Parent As Long
    Dim Task   As Long
    Dim Result As Long
    Dim Style  As Long
    Dim Title  As String
    Dim bFound As Boolean


    bFound = False

    'Darstellung des Fensters
    Style = GetWindowLong(hWnd, GWL_STYLE)
    Style = Style And (WS_VISIBLE Or WS_BORDER)

    'Titel des Fenster auslesen
    Result = GetWindowTextLength(hWnd) + 1
    Title = Space$(Result)
    Result = GetWindowText(hWnd, Title, Result)
    Title = Left$(Title, Len(Title) - 1)

    ' Toolbox ist sichtbar und ohne Titel...
    If Title = "" And Style = (WS_VISIBLE Or WS_BORDER) Then

        ' Elternfenster ermitteln
        Parent = hWnd
        Do
            Parent = GetParent(Parent)
        Loop Until Parent = 0

        ' Task Id ermitteln
        Result = GetWindowThreadProcessId(hWnd, Task)

        ' Task muß übereinstimmen
        If myTask = Task Then bFound = True
    End If

    GetWindowInfo = bFound

End Function


Function fGetScannerName()
    Dim HKey   As Long
    Dim Buffer As String * 255
    Dim Size   As Long
    Dim Typ    As Long

    Buffer = ""
    Size = 255

    fGetScannerName = ""

    ' Scanner erstmal unter HKLM suchen
    If RegOpenKeyA(HKEY_LOCAL_MACHINE, "SOFTWARE\WOI\O/i", HKey) = 0 Then
        RegQueryValueExA HKey, "Scanner", 0, Typ, Buffer, Size
        fGetScannerName = Buffer
    Else
        ' sonst auch unter HKCU
        If RegOpenKeyA(HKEY_CURRENT_USER, "SOFTWARE\WOI\O/i", HKey) = 0 Then
            RegQueryValueExA HKey, "Scanner", 0, Typ, Buffer, Size
            fGetScannerName = Buffer
        End If
    End If

    RegCloseKey HKey

End Function