Hallo zusammen.
In der letzten Zeit gab es immer wieder Probleme mit Office 2016 32-bit Version, da zahlreiche Personen keine Dateien mehr abspeichern konnten. Gelöst haben wir das Problem, in dem wir überall die 64-bit Version installiert haben. Nun hatte das Ganze jedoch einen Einfluss auf das Kassenbuch in Access. Dies kann nämlich nicht mehr geöffnet werden aufgrund eines Makro Fehlers.
"Fehler beim Kompilieren dieser Funktion. In dem Visual Basic Modul liegt ein Syntaxfehler vor."
Makroname: AutoExec
Aktionsname: AusführenCode
Argumente: MainFormLoad ()
Fehlernummer: 7960
Hier der Code des betroffenen Snippets:
Option Compare Database
Option Explicit
Declare Function SetWindowTextA Lib "user32" (ByVal hWnd As Long, ByVal lpString As String) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const strIniDatei = "Kassabuch.ini"
Public Const strMsg = "In Ihrer Anwendung ist folgendes Problem aufgetreten."
Public Const FDetail = 16314085 'Farbe Detailbereich Formular
Public Const FKopf = 12167064 'Farbe Kopfbereich Formular
Public Const FSidebar = 14337975 'Farbe der Sidebar
Public eh As New ErrorHandling 'Errorhandling und Edit/Update
Public strPfad As String
Public PfadData As String
Public PfadSQL As String
Public PfadProt As String
Public PfadDok As String
Public PfadVorlage As String
Public PfadImport As String
Public strFirma As String
Public FirmaID As Long '1=Hour of Power, 8=DABAMED
Public TabAutoEinbinden As Integer '0=nicht einbinden,1=verknüpfte Tabellen einbinden
Public aktJahr As Integer 'Jahr für Berichte
Public aktDatum As String ' aktuelles Datum als string z.B. #2007/03/23#
Public AuswahlMA As Long
Public ZusatzText As String 'Zusatztext wie z.B. Vertraulich für Berichte.
Public Rechte() As Long
Public SQLRechte(1 To 5) As String
Public Benutzer As String
Public UserLang As String
Public Compi As String
Public strFussZeile As String
Public AllowQuit As Boolean
Public strVersion As String
Public lngSprache As Long
Public lngRecID As Long
Public g_strInfo As String 'Globale Infozeile
Public g_Aufteilen As Long 'wurde der auftrag aufgeteilt
Public g_strSQL As String
Public r As Variant
Public lnRecnr As Long
Public lnAnzRec As Long
'*****************************************************************************
' Programmname : MainFormLoad()
' Autor :
'*****************************************************************************
' Beschreibung:
' Diese Prozedur wird zu Beginn der Applikation aufgerufen.
'*****************************************************************************
' History:
' 27.07.2016 Version 1.00 erstellt
'
' 09.11.2016 Version 1.01 erstellt
' - Upload mit Meldung
'
' 11.11.2016 Version 1.02
' - top7 Rangliste korrigiert
'
' 16.02.2017 Version 1.03
' - Ligaranglisten mit korrekturen
'*****************************************************************************
Function MainFormLoad()
On Error GoTo Err_FormLoad
Dim hWnd As Long
Dim dummy As String
Dim isIni As String
On Error Resume Next
'DB-Fenster ausblenden, bei Runtime nicht möglich
DoCmd.RunCommand acCmdWindowHide
On Error GoTo Err_FormLoad
strPfad = left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
PfadData = Ini_Lesen("Pfad", "PfadData", strIniDatei)
PfadProt = strPfad
strFirma = "EDJV"
FirmaID = "0"
lngSprache = 0
strFussZeile = "Vertraulich"
CheckTabellen PfadData 'bindet alle Tabellen der Data-Datenbank ein
strVersion = "Version 2.00 (01.12.2018) " & Dir(CurrentDb.Name)
hWnd = GetActiveWindow() ' Neuen Titel setzen
dummy = SetWindowTextA(hWnd, "Kassabuch " & strVersion)
Exit Function
Err_FormLoad:
MsgBox strMsg & Err & " / " & Err.Description, , "MainFormLoad"
AddError ("Runtime (MainFormLoad) ")
Resume Next
End Function
Function glAbmelden()
On Error Resume Next
AllowQuit = True
MainFormLoad
DoCmd.OpenForm ("frmLogin")
DoCmd.Close acForm, "frmmain"
End Function
Function glBeenden()
On Error Resume Next
If MsgBox("Möchten Sie das Programm wirklich verlassen", vbYesNoCancel, "Beenden") = vbYes Then
AddProt ("Programm Ende : " & strVersion & ", User: " & Benutzer)
AllowQuit = True
DoCmd.Quit acQuitSaveAll
End If
End Function
Public Function Ini_Lesen(ByVal Sektion As String, ByVal slKey As String, ByVal Datei As String) As String
On Error GoTo Err_Error
Dim retVal As String
Dim worked As Long
Dim IniDatei As String
IniDatei = CurrentProject.Path & "\" & Datei
retVal = String(255, " ")
worked = GetPrivateProfileString(Sektion, slKey, " ", retVal, Len(retVal), IniDatei)
Ini_Lesen = left(retVal, InStr(retVal, Chr(0)) - 1)
Exit Function
Err_Error:
MsgBox strMsg & Err & " / " & Err.Description, , "ini_Lesen"
Resume Next
End Function
Sub EnableShift(blnFlag As Boolean)
On Error GoTo Err_Error
Dim db As DAO.Database
Dim prp As DAO.Property
Set db = CurrentDb
'Property mit übergebenem Parameter belegen
db.Properties!AllowBypassKey = blnFlag
Exit_EnableShift:
Set prp = Nothing
Exit Sub
Err_Error:
'Property erzeugen, falls noch nicht vorhanden
If Err = 3270 Then
Set prp = db.CreateProperty("AllowBypassKey", dbBoolean, blnFlag)
db.Properties.Append prp
Resume Next
Else
MsgBox "Ausnahme Nr. " & str(Err.Number) & " " & Err.Description
Resume Exit_EnableShift
End If
End Sub
Function AendernStarteigenschaften(strName As String, varTyp As Variant, varWert As Variant) As Boolean
On Error GoTo Err_Error
Dim db As Database
Dim prp As Property
Const conPropNotError = 3270
Set db = CurrentDb
db.Properties(strName) = varWert
AendernStarteigenschaften = True
FunctionEnde:
Exit Function
Err_Error:
If Err = conPropNotError Then
Set prp = db.CreateProperty(strName, varTyp, varWert)
db.Properties.Append prp
Resume Next
Else
MsgBox Err.Description
AendernStarteigenschaften = False
Resume FunctionEnde
End If
End Function
Vielleicht kann mir jemand helfen? Ich verstehe leider ziemlich wenig von VBA und die Person, die den Code geschrieben hat, kann leider nicht mehr gefragt werden. Vielen Dank im Voraus.
|