General

6.34 Effettuare la copia di un file.
  Enrico Oemi
'----------------------------------------------------
' 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


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.