MS-Office-Forum

Zurück   MS-Office-Forum > Sonstiges > Job-Börse
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 26.05.2019, 06:37   #1
pinie_pinie
Neuer Benutzer
Neuer Benutzer
Standard Gesuch - Modul (32bit) auf 64bit anpassen

Hallo,

ich nutze einige Module in meiner Datenbank. Nun habe ich endlich rausgefunden,dass diese Module nur unter Access 32 bit laufen.
Kann mir jemand diese Module so anpassen, dass sie auf Access 32bit und 64bit laufen. Wenn beide nicht laufen, dann halt 64 bit.

Das Modul speichert den Pfad zu einem Dokument ab. Damit hat man eine "Verlinkung" zu diesem Dokument (siehe Foto).

Thoralf

PHP-Code:

Option Compare Database
Option Explicit

' Für Farbauswahl (einfache Variante, hier wird nur diese Deklaration benötigt)
    Declare PtrSafe Sub wlib_AccChooseColor Lib "msaccess.exe" Alias "#53" (ByVal Hwnd As Long, rgb As Long)

Datentyp definieren
    
Public Type BROWSEINFO
        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

' Konstanten für "ulFlags"
    Public Const BIF_RETURNONLYFSDIRS = &H1
    Public Const BIF_DONTGOBELOWDOMAN = &H2
    Public Const BIF_STATUSTEXT = &H4
    Public Const BIF_RETURNFSANCESTORS = &H8
    Public Const BIF_BROWSEFORCOMPUTER = &H1000
    Public Const BIF_BROWSEFORPRINTER = &H2000

API-Funktionen deklarieren
    
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias 
"SHGetPathFromIDListA" (ByVal pidl As LongByVal pszPath As String) As Long
    
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
    Alias 
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Type ACB_OPENFILENAME
        lStructSize 
As Long
        hwndOwner 
As Long
        hInstance 
As Long
        lpstrFilter 
As String
        lpstrCustomFilter 
As String
        nMaxCustFilter 
As Long
        nFilterIndex 
As Long
        lpstrFile 
As String
        nMaxFile 
As Long
        lpstrFileTitle 
As String
        nMaxFileTitle 
As Long
        lpstrInitialDir 
As String
        lpstrTitle 
As String
        flags 
As Long
        nFileOffset 
As Integer
        nFileExtension 
As Integer
        lpstrDefExt 
As String
        lCustData 
As Long
        lpfnHook 
As Long
        lpTemplateName 
As String
End Type

Declare PtrSafe Function API_DateiOeffnen Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As ACB_OPENFILENAME) As Long

Declare PtrSafe Function API_DateiSpeichern Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As ACB_OPENFILENAME) As Long

Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000                       '  
force long names for 3.x modules
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10

Dim pOpenfilename As ACB_OPENFILENAME

Function DateiOeffnen(strVerzeichnis As String, strTitel As String, FilterArt As String) As String
    
    Dim strFilter As String
    Dim strDateinameUndPfad As String
    Dim strDateiname As String
    Dim lngErgebnis As Long

Angebotene Dateifilter in der Dropdownliste "Dateityp"
    
Select Case FilterArt
        
Case "Access"
            
strFilter "Access-DB (*.mdb; *.mde)" Chr$(0) & "*.MDB; *.MDE" Chr$(0)
        Case 
"Wave"
            
strFilter "Wav-File (*.wav)" Chr$(0) & "*.wav" Chr$(0)
        Case 
"Wordvorlage"
            
strFilter "Wordvorlage (*.dot)" Chr$(0) & "*.dot" Chr$(0)
        Case 
"ALLE"
            
strFilter "Alle Dateien (*.*)" Chr$(0) & "*.*" Chr$(0)
            
strFilter strFilter "Worddokument (*.doc)" Chr$(0) & "*.doc" Chr$(0)
            
strFilter strFilter "Exceltabelle (*.xls)" Chr$(0) & "*.xls" Chr$(0)
            
strFilter strFilter "Textdatei (*.txt)" Chr$(0) & "*.txt" Chr$(0)
            
strFilter strFilter "Acrobatdatei (*.pdf)" Chr$(0) & "*.pdf" Chr$(0)
            
strFilter strFilter "Bitmap (*.bmp)" Chr$(0) & "*.bmp" Chr$(0)
            
strFilter strFilter "GIF-Bild (*.gif)" Chr$(0) & "*.gif" Chr$(0)
            
strFilter strFilter "JPG-Bild (*.jpg)" Chr$(0) & "*.jpg" Chr$(0)
    
End Select
    
' Vorgegebenes Verzeichnis
    If strVerzeichnis = "" Then
        strVerzeichnis = CurDir$ & Chr$(0) ' 
Wenn leerdann das aktuelle Verzeichnis verwenden
    
Else
        
strVerzeichnis strVerzeichnis Chr$(0' ANSI "0" an übergebenes Verzeichnis anhängen
    End If
    
    If strTitel = "" Then
        strTitel = "Datei-Öffnen" ' 
Wenn kein Titel übergebenStandardtitel festlegen
    
Else
        
strTitel strTitel Chr$(0' ANSI "0" an übergebenen Titel anhängen
    End If

Speicherplatz für Dateinamen Pfad reservieren
    strDateinameUndPfad 
Space$(255) & Chr$(0)
    
' Speicherplatz für Dateinamen ohne Pfad reservieren
    strDateiname = Space$(255) & Chr$(0)

'
Datenstruktur von pOPENFILENAME festlegen

    pOpenfilename
.lStructSize Len(pOpenfilename)
    
pOpenfilename.hwndOwner 0&
    
'pOpenfilename.hwndOwner = Application.hWndAccessApp
    pOpenfilename.lpstrFilter = strFilter
    pOpenfilename.nFilterIndex = 1
    pOpenfilename.lpstrFile = strDateinameUndPfad
    pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
    pOpenfilename.lpstrFileTitle = strDateiname
    pOpenfilename.nMaxFileTitle = Len(strDateiname)
    pOpenfilename.lpstrInitialDir = strVerzeichnis
    pOpenfilename.lpstrTitle = strTitel
    pOpenfilename.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
    pOpenfilename.nFileOffset = 0
    pOpenfilename.nFileExtension = 0
    pOpenfilename.lCustData = 0
    pOpenfilename.lpfnHook = 0
    pOpenfilename.lpTemplateName = ""

    lngErgebnis = API_DateiOeffnen(pOpenfilename)

    If lngErgebnis <> 0 Then
        DateiOeffnen = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) - 1)
    Else
        DateiOeffnen = ""
    End If

'    
If lngErgebnis <> 0 Then
'        DateiOeffnen = Left(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset - 1) & _
'        "*" 
Mid$(pOpenfilename.lpstrFilepOpenfilename.nFileOffset 1_
'        pOpenfilename.nFileExtension - pOpenfilename.nFileOffset - 1) & "*" & _
'        
Mid$(pOpenfilename.lpstrFilepOpenfilename.nFileExtension 1Len(pOpenfilename.lpstrFile) - pOpenfilename.nFileExtension)
'    Else
'        
DateiOeffnen ""
'    End If


End Function

Function DateiSpeichern(strVerzeichnis As String, strTitel As String, FilterArt As String) As String
    
    Dim strFilter As String
    Dim strDateinameUndPfad As String
    Dim strDateiname As String
    Dim lngErgebnis As Long

Angebotene Dateifilter in der Dropdownliste "Dateityp"
    
Select Case FilterArt
        
Case "Access"
            
strFilter "Access-DB (*.mdb; *.mde)" Chr$(0) & "*.MDB; *.MDE" Chr$(0)
        Case 
"Wave"
            
strFilter "Wav-File" Chr$(0) & "*.wav" Chr$(0) & Chr$(0)
        Case 
"Wordvorlage"
            
strFilter "Wordvorlage (*.dot)" Chr$(0) & "*.dot" Chr$(0)
    
End Select
    
' Vorgegebenes Verzeichnis
    If strVerzeichnis = "" Then
        strVerzeichnis = CurDir$ & Chr$(0) ' 
Wenn leerdann das aktuelle Verzeichnis verwenden
    
Else
        
strVerzeichnis strVerzeichnis Chr$(0' ANSI "0" an übergebenes Verzeichnis anhängen
    End If
    
    If strTitel = "" Then
        strTitel = "Datei-Speichern" ' 
Wenn kein Titel übergebenStandardtitel festlegen
    
Else
        
strTitel strTitel Chr$(0' ANSI "0" an übergebenen Titel anhängen
    End If

Speicherplatz für Dateinamen Pfad reservieren
    strDateinameUndPfad 
Space$(255) & Chr$(0)
    
' Speicherplatz für Dateinamen ohne Pfad reservieren
    strDateiname = Space$(255) & Chr$(0)

'
Datenstruktur von pOPENFILENAME festlegen

    pOpenfilename
.lStructSize Len(pOpenfilename)
    
pOpenfilename.hwndOwner 0&
    
'pOpenfilename.hwndOwner = Application.hWndAccessApp
    pOpenfilename.lpstrFilter = strFilter
    pOpenfilename.nFilterIndex = 1
    pOpenfilename.lpstrFile = strDateinameUndPfad
    pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
    pOpenfilename.lpstrFileTitle = strDateiname
    pOpenfilename.nMaxFileTitle = Len(strDateiname)
    pOpenfilename.lpstrInitialDir = strVerzeichnis
    pOpenfilename.lpstrTitle = strTitel
    pOpenfilename.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
    pOpenfilename.nFileOffset = 0
    pOpenfilename.nFileExtension = 0
    pOpenfilename.lCustData = 0
    pOpenfilename.lpfnHook = 0
    pOpenfilename.lpTemplateName = ""

    lngErgebnis = API_DateiSpeichern(pOpenfilename)

    If lngErgebnis <> 0 Then
        DateiSpeichern = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) - 1)
    Else
        DateiSpeichern = ""
    End If

'    
If lngErgebnis <> 0 Then
'        Speichern = Left(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset - 1) & _
'        "*" 
Mid$(pOpenfilename.lpstrFilepOpenfilename.nFileOffset 1_
'        pOpenfilename.nFileExtension - pOpenfilename.nFileOffset - 1) & "*" & _
'        
Mid$(pOpenfilename.lpstrFilepOpenfilename.nFileExtension 1Len(pOpenfilename.lpstrFile) - pOpenfilename.nFileExtension)
'    Else
'        
Speichern ""
'    End If

End Function

Function VerzeichnisDialog(Optional strMeldung) As String
    
-------------------------------------------------------------------
' Dialogfeld zur Verzeichnisauswahl anzeigen und
gewählten Pfad zurückgeben
' -------------------------------------------------------------------
    
Dim bInfo As BROWSEINFO
Dim strPath As String
Dim lngRueckgabe As Long
Dim lngItemID As Long
Dim intPos As Integer
 
' "Desktop" 
als oberste Ebene
    bInfo
.pidlRoot 0&

' Die gewünschte Meldung einsetzen oder Standard verwenden
    If IsMissing(strMeldung) Then
        bInfo.lpszTitle = "Bitte wählen Sie einen Ordner aus:"
    Else
        bInfo.lpszTitle = strMeldung
    End If

Flag setzen
    bInfo
.ulFlags BIF_RETURNONLYFSDIRS

' Auswahl-Dialog anzeigen
    lngItemID = SHBrowseForFolder(bInfo)
    
Ergebnis in Pfad umwandeln
    strPath 
Space$(512)
    
lngRueckgabe SHGetPathFromIDList(ByVal lngItemIDByVal strPath)
    If 
lngRueckgabe Then
        intPos 
InStr(strPathChr$(0))
        
VerzeichnisDialog Left(strPathintPos 1)
    Else
        
VerzeichnisDialog ""
    
End If

End Function 


PHP-Code:

Private Sub Befehl2_Click()

On Error GoTo Fehler

Dim db 
As Database
Dim rs 
As Recordset
Dim DocPfad 
As String
Dim a 
As Variant

    Set db 
CurrentDb()
    
Set rs db.OpenRecordset("Dokumente"dbOpenDynaset)
    
        
DateiOeffnen("C:""Bitte Dokument auswählen:""ALLE")
        If 
IsNull(a) Or "" Then
        
Else
            
DocPfad a
            rs
.AddNew
                rs
!DocPfad DocPfad
                rs
!KndNr Me.KndNr
            rs
.Update
        End 
If
        
Me.UForm.Requery
        
    rs
.Close
    db
.Close
    
ende
:
    Exit 
Sub
    
Fehler
:
    
MsgBox Err.Description16"http://www.access-home.de"
    
Resume ende
    
End Sub 
Angehängte Grafiken
Dateityp: png Dokument.PNG (10,0 KB, 4x aufgerufen)
pinie_pinie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.05.2019, 14:50   #2
Mike
MOF Profi
MOF Profi
Standard

Hallo Thoralf,
die laufen doch beide unter 32 und 64 Bit?!
Mike
Mike ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.05.2019, 18:06   #3
pinie_pinie
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Mike,

nach unzähligen Test steht fest 32bit ja 64bit nein.
Was meinst du wie lange ich gebraucht habe, um das rauszubekommen.
Mein Festrechner Access 2016 32bit läuft ohne Probleme. Laptop Access 2016 64bit läuft das Script garnicht an.
Kannst du helfen?

Thoralf
pinie_pinie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.05.2019, 18:09   #4
Mike
MOF Profi
MOF Profi
Standard

Hallo Thoralf,

ich habe deinen Code in eine 64-Bit Datenbank gepackt und ohne Probleme kompilieren können. Also 64-Bit-kompatibel.

Mike
Mike ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.05.2019, 18:53   #5
pinie_pinie
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Mike,

ich rede nur als Praktiker, also nicht wundern wenn ich falsche Begriffe verwende.
Ich drücke einen Button (dahinter liegt der Befehl2) und es öffnet sich der Explorer zur Auswahl einer Datei. Das passiert bei der 32bit Version von Access.
Bei der 64bit Version tut sich nichts!!!!
Ich habe den Code auch in der 64bit Umgebung kompilieren lassen. Es kommt zu keiner Fehlermeldung. Trotzdem läuft die identische Datenbank nicht auf einem
64bit Access. Also kann es doch nur daran liegen.
Ich habe einen Vorgang in diesem Forum. Da wurde mir auch bestätigt, dass in der 64bit Version teilweise andere "Befehle" verwendet werden.


Thoralf
pinie_pinie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.05.2019, 21:17   #6
Mike
MOF Profi
MOF Profi
Standard

Hallo Thoralf,

ich habe kein Formular, deshalb kann ich auch keinen Knopf drücken.
Ich habe den Code nur auf 64-Bit-Basis kompiliert und keinen Fehler erhalten.
Fehler die bei dir auftreten können also nur von der Programmierung selbst herrühren, z. B: wo der Ausdruck ' Me.' verwendet wird.

Mike
Mike ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.05.2019, 09:14   #7
derHoepp
MOF User
MOF User
Standard

Hallo Mike,

die Deklaration als Pointersafe genügt dem Compiler schon, um zu behaupten, es wäre alles in Ordnung. Wenn ich das richtig sehe, hat Thoralf genau das gemacht. Er hat die API-Functions als PtrSafe deklariert (ohne sicherzustellen, dass die Function tatsächlich Pointersafe ist). Allerdings ist der API-Function die reine Deklaration von PtrSafe egal. Die API-Function will für 64-Bit-Calls stellenweise andere Datentypen (LongLong oder LongPtr). Leider gibt es keine Regelmäßigkeit dabei, sodass jemand für jede API herausfinden muss, welcher Parameter in einer 64-Bit Umgebung anders übergeben werden muss (in der API-Deklaration und bei einer tatsächlichen Übergabe einer Variablen). Ich glaube Nepumuk hat da einen recht großen Fundus an fertigen 64-Bit Funktionsköpfen.
Da die Anforderung ist, das ganze auch noch mit bedingter Kompilierung zu erstellen, ist das halt eine Aufgabe für einen bezahlten Auftrag.

Viele Grüße
derHöpp
derHoepp ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.05.2019, 17:57   #8
pinie_pinie
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo in die Runde,

ich verstehe nur Bahnhof (VBA).
Ich würde mich freuen, wenn mein Programm auch wieder unter Access 2016 64bit läuft. Sollte ein Aufwand entstehen, würde ich natürlich einen kleinen Obolus entrichten.
Scheinbar ist es aber doch nicht so einfach die Befehle anzupassen.


Thoralf
pinie_pinie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.05.2019, 18:27   #9
Mike
MOF Profi
MOF Profi
Standard

Hallo Thoralf,
schick mir mal deine Datenbank, dann kann ich alles auf 64-Bit-Access testen.
hb@steingruben-net.de
Mike
Mike ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.05.2019, 09:07   #10
pinie_pinie
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Mike,

kriege die Mail nicht rüber. Stimmt was an der Adresse nicht?

Thoralf
pinie_pinie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.05.2019, 09:11   #11
Mike
MOF Profi
MOF Profi
Standard

Die Adresse ist korrekt
Mike ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:54 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.