asked on

Simple backup function...

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

vinnyd79

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

vinnyd79

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

ASKER CERTIFIED SOLUTION

aelatik

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

EDDYKT

may be use shell with xcopy