Thema Datum  Von Nutzer Rating
Antwort
Rot Makro funktioniert nicht mehr unter 64-bit Access
29.01.2020 12:57:26 Silence
Solved
29.01.2020 19:35:34 amicro2000
Solved

Ansicht des Beitrags:
Von:
Silence
Datum:
29.01.2020 12:57:26
Views:
1104
Rating: Antwort:
 Nein
Thema:
Makro funktioniert nicht mehr unter 64-bit Access

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.

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro funktioniert nicht mehr unter 64-bit Access
29.01.2020 12:57:26 Silence
Solved
29.01.2020 19:35:34 amicro2000
Solved