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
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
