FredixBlog

This function copies a file

Const FOF_NOCONFIRMMKDIR = &H200
Const FOF_FILESONLY = &H80

Private Type SHFILEOPSTRUCT
      hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Boolean
    hNameMaps As Long
    sProgress As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Function MyFileCopy(txtSource, txtDestination)
Dim lFileOp As Long
Dim lresult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim chkSilent, chkYesToAll, chkRename, chkDir, chkFilesOnly As Boolean

DoCmd.Hourglass True

lFileOp = FO_COPY

chkYesToAll = True
chkSilent = True

If chkSilent Then lFlags = lFlags Or FOF_SILENT
If chkYesToAll Then lFlags = lFlags Or FOF_NOCONFIRMATION
If chkRename Then lFlags = lFlags Or FOF_RENAMEONCOLLISION
If chkDir Then lFlags = lFlags Or FOF_NOCONFIRMMKDIR
If chkFilesOnly Then lFlags = lFlags Or FOF_FILESONLY
'
' NOTE: By adding the FOF_ALLOWUNDO flag you can move
' a file to the Recycle Bin instead of deleting it.
'
With SHFileOp
    .wFunc = lFileOp
    .pFrom = txtSource & vbNullChar & vbNullChar
    .pTo = txtDestination & vbNullChar & vbNullChar
    .fFlags = lFlags
End With
lresult = SHFileOperation(SHFileOp)
'
' If User hit Cancel button while operation is in progress,
' the fAborted parameter will be true
'
DoCmd.Hourglass False
'If lresult <> 0 Or SHFileOp.fAborted Then Exit Function
'MsgBox "Operation Complete", vbInformation, "File Operations"
MyFileCopy = lresult
End Function

• Create ODBC DSN
• Clear all line breaks
• GetOpenFileName()
• Gibson plus solide que Fender?
• Display a counter and remaining time in a loop
• Truncate long path names
• How can I e-mail a file from Microsoft Access?
• Create a linked table with VBA
• Coordinates of the third point
• Message to log file

Creates a system ODBC DSN thru a program.
As you can see, we create the DSN by making an entry in the registry.
In your Project you need Form1 and a command button Command1. Here’s the code for the General Declarations:

    Option Explicit

    Private Const REG_SZ = 1 'Constant for a string variable type.
    Private Const HKEY_LOCAL_MACHINE = &H80000002

    Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
       "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
       phkResult As Long) As Long

    Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
       "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
       ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _
       cbData As Long) As Long

    Private Declare Function RegCloseKey Lib "advapi32.dll" _
       (ByVal hKey As Long) As Long

Next go to the click event of the Command1 button and enter the following:

Private Sub Command1_Click()

   Dim DataSourceName As String
   Dim DatabaseName As String
   Dim Description As String
   Dim DriverPath As String
   Dim DriverName As String
   Dim LastUser As String
   Dim Regional As String
   Dim Server As String

   Dim lResult As Long
   Dim hKeyHandle As Long

   'Specify the DSN parameters.

   DataSourceName = " "
   DatabaseName = ""
   Description = "<a>"
   DriverPath = " "
   LastUser = ""
   Server = ""
   DriverName = "SQL Server"</a>

   'Create the new DSN key.

   lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" &amp; _
        DataSourceName, hKeyHandle)

   'Set the values of the new DSN key.

   lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, _
      ByVal DatabaseName, Len(DatabaseName))
   lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _
      ByVal Description, Len(Description))
   lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
      ByVal DriverPath, Len(DriverPath))
   lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, _
      ByVal LastUser, Len(LastUser))
   lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
      ByVal Server, Len(Server))

   'Close the new DSN key.

   lResult = RegCloseKey(hKeyHandle)

   'Open ODBC Data Sources key to list the new DSN in the
ODBC Manager.
   'Specify the new value.
   'Close the key.

   lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
      "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources",
hKeyHandle)
   lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&,
REG_SZ, _
      ByVal DriverName, Len(DriverName))
   lResult = RegCloseKey(hKeyHandle)

   End Sub

• Copy a file
• Display a counter and remaining time in a loop
• Truncate long path names
• How can I e-mail a file from Microsoft Access?
• Clear all line breaks
• GetOpenFileName()
• Relink all tables
• ShellWait()
• Gibson plus solide que Fender?
• Create a linked table with VBA