'----------------------------------------------------
' Da inserire nelle dichiarazioni del modulo
'----------------------------------------------------
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage.
End Type
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
'----------------------------------------------------
' Utile x sapere su che SO sta girando Access
'----------------------------------------------------
Function SysVersions32() As String
Dim V As OSVERSIONINFO, retval As Long
Dim WindowsVersion As String, BuildVersion As String
Dim PlatformName As String
V.dwOSVersionInfoSize = Len(V)
retval = GetVersionEx(V)
WindowsVersion = V.dwMajorVersion & "." & V.dwMinorVersion
BuildVersion = V.dwBuildNumber And &HFFFF&
Select Case V.dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
PlatformName = "Windows 95"
Case VER_PLATFORM_WIN32_NT
PlatformName = "Windows NT"
Case Else
PlatformName = "Unknown"
End Select
SysVersions32 = PlatformName
End Function
'----------------------------------------------------
' Effettua copia del file
'----------------------------------------------------
Function VBAbackup(ByVal sorgente As String, ByVal destinazione As String) As Boolean
'Autore: Oemi Enrico
'Accetta:
' sorgente = path+nome del file da copiare
' destinazione = path+nome del file di destinazione
'Restituisce: true se l'operazione si e' conclusa posotivamente
Dim stringa1 As String
Dim stringa2 As String
If Dir(sorgente) = " " Then GoTo errore
If Not Dir(destinazione) = "" Then
If MsgBox("Sovrascrivere?", vbYesNo) = vbNo Then GoTo errore
End If
stringa1 = "copy " & sorgente & " " & destinazione & ""
If SysVersions32() = "windows NT" Then
On Error GoTo errore
stringa2 = "cmd /c " & "" & stringa1 & ""
Shell stringa2, vbHide
ElseIf SysVersions32() = "Windows 95" Then
stringa2 = "command.com /c " & "" & stringa1 & ""
Shell stringa2, vbHide
End If
VBAbackup = True
Exit Function
errore:
VBAbackup = False
End Function
|