We help IT Professionals succeed at work.

Simple backup function...

jm_jackson
jm_jackson asked
on
155 Views
Last Modified: 2010-05-03
Hi,

Could anyone give me a bit of help with a simple backup function I want for a sample project I'm working on? Any code would be useful.

I basically have a few .dat files in a folder and I want to be able to make a copy of each and then save them in a different location / folder by clicking a button. This is to be done from a form in VB, preferably with the options to specify the backup location.

It may be useful to have the ability to browse / specify the location from which the files are to be backed up from. I'll probably only have the same files that are always to be backed up though, so this isn't essential at the moment.

Thanks,

Jon J
Comment
Watch Question

Commented:
You can use the SHFileOP api. Try adding 2 textboxes and a command button.Text1 is for the folder to copy and Text2 is for the destination folder name.

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40
Const FOF_SILENT = &H4
Const FOF_NOCONFIRMATION = &H10
Const FOF_RENAMEONCOLLISION = &H8
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 Sub Command1_Click()
Dim result As Long, fileop As SHFILEOPSTRUCT
With fileop
     .hwnd = Me.hwnd
     .wFunc = FO_COPY
     .pFrom = Text1.Text & vbNullChar & vbNullChar
     .pTo = Text2.Text & vbNullChar & vbNullChar
     .fFlags = FOF_NOCONFIRMMKDIR
End With
result = SHFileOperation(fileop)
If result <> 0 Then
     ' Operation failed
     MsgBox Err.LastDllError
End If
End Sub

Commented:
try pasting this into a form and add 2 textboxes and 3 command buttons.Command1 is to select the source folder,Command2 is to select the destination folder.The destination folder will get created if it does not exist,but the path must be valid.Command3 will do the copy.


Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_NOCONFIRMMKDIR = &H200
Private Const FOF_FILESONLY = &H80
Private Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type
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 Sub Command1_Click()
' command button to set the source directory in Textbox Text1
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo

With udtBI
    'Set the owner window
    .hWndOwner = Me.hwnd
    'lstrcat appends the two strings and returns the memory address
    .lpszTitle = lstrcat("C:\", "")
    'Return only if the user selected a directory
    .ulFlags = BIF_RETURNONLYFSDIRS
End With

'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    'Get the path from the IDList
    SHGetPathFromIDList lpIDList, sPath
    'free the block of memory
    CoTaskMemFree lpIDList
    iNull = InStr(sPath, vbNullChar)
    If iNull Then
        sPath = Left$(sPath, iNull - 1)
    End If
End If

Text1.Text = sPath
End Sub

Private Sub Command2_Click()
' command button to set the Destination directory in Textbox Text2
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo

With udtBI
    'Set the owner window
    .hWndOwner = Me.hwnd
    'lstrcat appends the two strings and returns the memory address
    .lpszTitle = lstrcat("C:\", "")
    'Return only if the user selected a directory
    .ulFlags = BIF_RETURNONLYFSDIRS
End With

'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    'Get the path from the IDList
    SHGetPathFromIDList lpIDList, sPath
    'free the block of memory
    CoTaskMemFree lpIDList
    iNull = InStr(sPath, vbNullChar)
    If iNull Then
        sPath = Left$(sPath, iNull - 1)
    End If
End If

Text2.Text = sPath
End Sub

Private Sub Command3_Click()
' command button to do the copy
' make sure there is a destination dir in Text2
If Trim$(Text2.Text) = "" Then
    MsgBox "You Must Enter a Destination Directory Name"
    Exit Sub
End If

' copy
Dim result As Long, fileop As SHFILEOPSTRUCT
With fileop
     .hwnd = Me.hwnd
     .wFunc = FO_COPY
     .pFrom = Text1.Text & vbNullChar & vbNullChar
     .pTo = Text2.Text & vbNullChar & vbNullChar
     .fFlags = FOF_NOCONFIRMMKDIR
End With
result = SHFileOperation(fileop)
If result <> 0 Then
     ' Operation failed
     MsgBox Err.LastDllError
End If
End Sub
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Commented:
may be use shell with xcopy
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.