[MS Access]

Discussione in 'MS Access' iniziata da dario21, 9 Aprile 2019.

  1. dario21

    dario21 Nuovo Utente

    Registrato:
    19 Febbraio 2019
    Messaggi:
    9
    Mi Piace Ricevuti:
    0
    Punteggio:
    1
    Sesso:
    Maschio
    Occupazione:
    commesso part time
    Località:
    roma
    buongiorno,
    premetto che da poco mi sto interfacciando con vba access e girando in rete h trovato un modulo che poteva interessarmi.
    nel trascrivere il modulo di access 2003 nel mio database access 2016 mi restituisce numerosi eerori che non so correggere :(
    se gentilmente qualcuno mi può aiutare ne sarei veramente grato
    di seguito il codice di cui parlavo

    Codice:
    Option Compare Database
    Option Explicit
    
    
    
    Private Declare Function GetAllSettings Lib "kernel32" Alias "GetVersionExA" (lpOSInfo As OSVERSIONINFO) As Boolean
    Private Declare Function api_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    'Declares for Version Verification
    Private Declare Function ac_GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
    Private Declare Function ac_GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
    Private Declare Function ac_VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
    Private Declare Sub ac_MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
    
    Const Jet_FILENAME = "MSJT3032.DLL"
    Const Jet35_FILE = "msjet35.dll"
    Const SEM_FAILCRITICALERRORS = &H1
        
    ' Type returned by VER.DLL GetFileVersionInfo
    Private Type VS_FIXEDFILEINFO
        dwSignature As Long
        dwStrucVersionl As Integer     '  e.g. = &h0000 = 0
        dwStrucVersionh As Integer     '  e.g. = &h0042 = .42
        dwFileVersionMSl As Integer    '  e.g. = &h0003 = 3
        dwFileVersionMSh As Integer    '  e.g. = &h0075 = .75
        dwFileVersionLSl As Integer    '  e.g. = &h0000 = 0
        dwFileVersionLSh As Integer    '  e.g. = &h0031 = .31
        dwProductVersionMSl As Integer '  e.g. = &h0003 = 3
        dwProductVersionMSh As Integer '  e.g. = &h0010 = .1
        dwProductVersionLSl As Integer '  e.g. = &h0000 = 0
        dwProductVersionLSh As Integer '  e.g. = &h0031 = .31
        dwFileFlagsMask As Long        '  = &h3F for version "0.42"
        dwFileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
        dwFileOS As Long               '  e.g. VOS_DOS_WINDOWS16
        dwFileType As Long             '  e.g. VFT_DRIVER
        dwFileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
        dwFileDateMS As Long           '  e.g. 0
        dwFileDateLS As Long           '  e.g. 0
     End Type
    Type fBuffer
        Item As String * 1024
    End Type
    
    
    Private Type OSVERSIONINFO
       dwOSVersionInfoSize As Long
       dwMajorVersion As Long
       dwMinorVersion As Long
       dwBuildNumber As Long
       dwPlatformId As Long
       strReserved As String * 128
    End Type
    
    Function atGetjetver() As String
    '*******************************************
    'Purpose:  Returns Version information on Jet DB Engine
    '          Based on the Version of Access Used
    '*******************************************
    Dim Buffer As fBuffer
    Dim VInfo As VS_FIXEDFILEINFO
    Dim stBuf() As Byte
    Dim lSize As Long
    Dim stUnused As Long
    Dim ErrCode As Long
    Dim VerNum As Variant
    Dim lVerPointer       As Long
    Dim lVerbufferLen     As Long
    Dim Jet$
    
    If SysCmd(acSysCmdAccessVer) < "8" Then
        Jet = Jet_FILENAME
    Else
        Jet = Jet35_FILE
    End If
        
    lSize = ac_GetFileVersionInfoSize(Jet, stUnused)
    ReDim stBuf(lSize)
    ErrCode = ac_GetFileVersionInfo(Jet, 0&, lSize, stBuf(0))
        
    ErrCode = ac_VerQueryValue(stBuf(0), "\", lVerPointer, lVerbufferLen)
        
    If ErrCode <> 0 Then
        ac_MoveMemory VInfo, lVerPointer, Len(VInfo)
        
        VerNum = Format$(VInfo.dwFileVersionMSh) & "." & _
        Format$(VInfo.dwFileVersionMSl) & "." & _
        Format$(VInfo.dwFileVersionLSh) & "." & _
        Format$(VInfo.dwFileVersionLSl)
    End If
    atGetjetver = VerNum
    End Function
    Function atWinver(intOSInfo%) As Variant
    '***********************************************
    'Purpose:  Retrieve operating system information
    'Accepts: intOSInfo: which piece of information to retrieve
       '        0: Major Version
       '        1: Minor version
       '        2: Platform ID
    ' Returns: OS supplied Information
    '***********************************************
    Dim OSInfo As OSVERSIONINFO
    Dim dwReturn&
    Const PLAT_WINDOWS = 1
    Const PLAT_WIN_NT = 2
    'Set the size= to length of structure
    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    
    If GetVersionEx(OSInfo) Then
       Select Case intOSInfo
          Case 0
             atWinver = OSInfo.dwMajorVersion
          Case 1
             atWinver = OSInfo.dwMinorVersion
          Case 2
             dwReturn = OSInfo.dwPlatformId
             If dwReturn = PLAT_WINDOWS Then
                 atWinver = "Windows"
             Else
                 atWinver = "Windows NT"
             End If
         Case 3
             If OSInfo.dwPlatformId = PLAT_WINDOWS Then
                 atWinver = OSInfo.dwBuildNumber And &HFFF
             Else
                 atWinver = OSInfo.dwBuildNumber
             End If
       End Select
    Else
       atWinver = 0
    End If
    
    End Function
    Public Function atCNames(UOrC As Integer) As String
    '**************************************************
    'Purpose:  Returns the User LogOn Name or ComputerName
    'Accepts:  UorC; 1=User, anything else = computer
    'Returns:  The Windows Networking name of the user or computer
    '**************************************************
    On Error Resume Next
    Dim NBuffer As String
    Dim Buffsize As Long
    Dim Wok As Long
        
    Buffsize = 256
    NBuffer = Space$(Buffsize)
    
    If UOrC = 1 Then
        Wok = api_GetUserName(NBuffer, Buffsize)
        atCNames = Left$(NBuffer, InStr(NBuffer, Chr(0)) - 1)
    Else
        Wok = api_GetComputerName(NBuffer, Buffsize)
        atCNames = Left$(NBuffer, InStr(NBuffer, Chr(0)) - 1)
    End If
    
    End Function
    
    
    Sub connessi()
    
    End Sub
    
     
  2. Max 1

    Max 1 Super Moderatore Membro dello Staff SUPER MOD MOD

    Registrato:
    29 Febbraio 2012
    Messaggi:
    3.802
    Mi Piace Ricevuti:
    283
    Punteggio:
    83
    Sesso:
    Maschio
    @dario21
    Dal regolamento del forum
    Modifica il titolo della discussione altrimenti sono costretto a chiuderla!
    Grazie
     
  3. CarlettoFed

    CarlettoFed Utente Attivo

    Registrato:
    17 Luglio 2017
    Messaggi:
    74
    Mi Piace Ricevuti:
    1
    Punteggio:
    8
    Sesso:
    Maschio
    Intanto dovresti dire a cosa ti serve tutto quel codice in modo da poter valutare altre soluzioni più semplici.
     
Sto caricando...

Condividi questa Pagina