Use FileCopy with Save As Menu

[Islwyn]

I would like to create a button on an MS Access form that will give the user the option of where the files specified by me in the code will go - in other words I want to use the FileCopy command without a pre-specified destination - Ideally I'd like a Windows popup box giving the classic "Save In" options listing all the folders/drives etc. on "My Computer"

Thanks

 

[GKProgrammer]

Hi Islwyn,

I think the below code will do the trick for you. It should be fairly self explanatory, if you have any troubles with the code just post and I can help you out.


--------------CODE BEGINS---------------------
'global declarations
Option Compare Database
Option Explicit

Type shellBrowseInfo
hWndOwner As Long
pIDlRoot As Long
pszDisplayName As Long
IpszTitle As String
uIFlags As Long
IpfnCallBack As Long
IParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib "shell32" (Ipbi As shellBrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal IpBuffer As String) As Long

Function YourButton_Click()
Dim temphwnd As Long
Dim Value
Dim Title As String

Title = "Choose Location to Save File In"
temphwnd = Screen.Application.hWndAccessApp
Value = GetFolder(Title, temphwnd)

If Value <> &quot;Empty&quot; Then
'FileCopy function here
End If

End Function

Public Function GetFolder(dlgTitle As String, Frmhwnd As Long) As String

Dim intNullChr As Integer
Dim IngIDlist As Long
Dim IngResult As Long
Dim strFolder As String
Dim BI As shellBrowseInfo


With BI
.hWndOwner = Frmhwnd
.IpszTitle = dlgTitle
.uIFlags = BIF_RETURNONLYFSDIRS
End With

IngIDlist = SHBrowseForFolder(BI)
If IngIDlist <> 0 Then
strFolder = String$(MAX_PATH, 0)
IngResult = SHGetPathFromIDList(IngIDlist, strFolder)
Call CoTaskMemFree(IngIDlist)
intNullChr = InStr(strFolder, vbNullChar)
If intNullChr Then
strFolder = Left$(strFolder, intNullChr - 1)
End If
Else
GetFolder = &quot;Empty&quot;
Exit Function
End If

GetFolder = strFolder


End Function


--------------------END CODE---------------


Let me know if this helps.

Regards,
gkprogrammer

 

[Islwyn]

Many thanks for that. Just one question before I try it out which might sound stupid - I used to be a FORTRAN programer and have virtually no Visual Basic!
Where you've put &quot; 'FileCopy function here &quot; would I just write FileCopy &quot;C:\MyFolderName\MyFileName&quot;, Value
In other words how do I specify the source and destination (as selected by the user) in the FileCopy statement? Also can I put the filecopy command in more than once?

Thanks again for your help

Islwyn

 

[GKProgrammer]

Sounds like you understand properly, the variable 'Value' will be used as your destination and you can use the Filecopy statement as many times as you like, good luck.



Regards,
gkprogrammer

 

[Islwyn]

Hi GKProgrammer
I’ve put the code in and I’m getting an error when I press the button: “Cannot define a Public user-defined type within an object module” (I get the same error when I use the debugger).
Any ideas?

Cheers

Nick

 

[GKProgrammer]

Did you place the below snippet of the code in the global declarations section of the Form?

Type shellBrowseInfo
hWndOwner As Long
pIDlRoot As Long
pszDisplayName As Long
IpszTitle As String
uIFlags As Long
IpfnCallBack As Long
IParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib &quot;ole32.dll&quot; (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib &quot;shell32&quot; (Ipbi As shellBrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib &quot;shell32&quot; (ByVal pidList As Long, ByVal IpBuffer As String) As Long


If not try placing it in the global declarations section and try again.

Regards,
gkprogrammer

 

[Islwyn]

Sorry, I just copied the entire piece of code into the Basic Editor. How exactly do I find the global declarations for the entire form? I've clicked on form but it already has the code at the top. Should I precede the code with some kind of statement?

Cheers

Nick

 

[Islwyn]

Sorry, I just copied the entire piece of code into the Basic Editor. How exactly do I find the global declarations for the entire form? I've clicked on form but it already has the code at the top. Should I precede the code with some kind of statement?

Cheers

Islwyn

 

[Islwyn]

Here's the entire code in the form:



'global declarations
Option Compare Database
Option Explicit

Type shellBrowseInfo
hWndOwner As Long
pIDlRoot As Long
pszDisplayName As Long
IpszTitle As String
uIFlags As Long
IpfnCallBack As Long
IParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib &quot;ole32.dll&quot; (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib &quot;shell32&quot; (Ipbi As shellBrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib &quot;shell32&quot; (ByVal pidList As Long, ByVal IpBuffer As String) As Long

Function Command0_Click()
Dim temphwnd As Long
Dim Value
Dim Title As String

Title = &quot;C:\&quot;
temphwnd = Screen.Application.hWndAccessApp
Value = GetFolder(Title, temphwnd)

If Value <> &quot;Empty&quot; Then
FileCopy &quot;C:\PEDIGREE FLOCK\TABLES\Password.mdb&quot;, Value ' Copy source to target.

End If

End Function

Public Function GetFolder(dlgTitle As String, Frmhwnd As Long) As String

Dim intNullChr As Integer
Dim IngIDlist As Long
Dim IngResult As Long
Dim strFolder As String
Dim BI As shellBrowseInfo


With BI
.hWndOwner = Frmhwnd
.IpszTitle = dlgTitle
.uIFlags = BIF_RETURNONLYFSDIRS
End With

IngIDlist = SHBrowseForFolder(BI)
If IngIDlist <> 0 Then
strFolder = String$(MAX_PATH, 0)
IngResult = SHGetPathFromIDList(IngIDlist, strFolder)
Call CoTaskMemFree(IngIDlist)
intNullChr = InStr(strFolder, vbNullChar)
If intNullChr Then
strFolder = Left$(strFolder, intNullChr - 1)
End If
Else
GetFolder = &quot;Empty&quot;
Exit Function
End If

GetFolder = strFolder


End Function




Private Sub Form_Load()

End Sub

Any ideas

Cheers

Islwyn

 

[GKProgrammer]

It appears that it is already in the global declarations, I have used this code on many occasions without fail, I'm not sure why you are having problems with creating a user-defined type. I did notice one problem though, when using the FileCopy statement the variable 'Value' will only be the Path to the folder to save the file, you will have to append the filename.ext to the end of the variable 'Value' to correctly save the file.

Regards,
gkprogrammer

 

[Islwyn]

OK Thanks, I'll have a fiddle with it and any more suggestions as to what might be preventing it working would be gratefully accepted - I'm using ccess 2000 if that helps. Could it be something to do with how I'm opening the program (i.e. something like open exclusive) or am I just showing my ignorance?
One quick question - If I do get it to work how do I attach the file name - presumably something like Value&quot;/filename.mdb&quot; ?

Cheers

 

[Islwyn]

Hi, I've managed to get it half working somehow. It seems there was some kind of problem with the word &quot;shellBrowseInfo&quot; and when I changed it to another word
(Nickstype) it seems to have stopped the error.

The problem I'm having now is that the files always go to the root of the C drive regardless of what location I specify - is it perhaps a problem with my use of & in Tables = Value & &quot;\PEDIGREE FLOCK TABLES.mdb&quot;
I tried taking the \ out but then they just don't go anywhere


Here's the code:
I placed your declaration code in a module:
------------------------------------
Option Compare Database
Option Explicit

Type Nickstype
hWndOwner As Long
pIDlRoot As Long
pszDisplayName As Long
IpszTitle As String
uIFlags As Long
IpfnCallBack As Long
IParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib &quot;ole32.dll&quot; (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib &quot;shell32&quot; (Ipbi As Nickstype) As Long
Declare Function SHGetPathFromIDList Lib &quot;shell32&quot; (ByVal pidList As Long, ByVal IpBuffer As String) As Long
------------------------------------

Then I put the following code in the form:

---------------------------------------


Private Sub backuptoexternal_Click()
Dim temphwnd As Long
Dim Value
Dim Tables, Password
Dim Title As String

Title = &quot;Choose Location to Save File In&quot;
temphwnd = Screen.Application.hWndAccessApp
Value = GetFolder(Title, temphwnd)
Password = Value & &quot;\password.mdb&quot;
Tables = Value & &quot;\PEDIGREE FLOCK TABLES.mdb&quot;
If Value <> &quot;Empty&quot; Then
FileCopy &quot;C:\PEDIGREE FLOCK\TABLES\password.mdb&quot;, Password ' Copy source to target.
FileCopy &quot;C:\PEDIGREE FLOCK\TABLES\PEDIGREE FLOCK TABLES.mdb&quot;, Tables
End If
End Sub

Public Function GetFolder(dlgTitle As String, Frmhwnd As Long) As String

Dim intNullChr As Integer
Dim IngIDlist As Long
Dim IngResult As Long
Dim strFolder As String
Dim BI As Nickstype


With BI
.hWndOwner = Frmhwnd
.IpszTitle = dlgTitle
.uIFlags = BIF_RETURNONLYFSDIRS
End With

IngIDlist = SHBrowseForFolder(BI)
If IngIDlist <> 0 Then
strFolder = String$(MAX_PATH, 0)
IngResult = SHGetPathFromIDList(IngIDlist, strFolder)
Call CoTaskMemFree(IngIDlist)
intNullChr = InStr(strFolder, vbNullChar)
If intNullChr Then
strFolder = Left$(strFolder, intNullChr - 1)
End If
Else
GetFolder = &quot;Empty&quot;
Exit Function
End If

GetFolder = strFolder


End Function

-----------------------------------------

Any more ideas

Cheers

Nick

 

[GKProgrammer]

Hi Nick,

I copied the above code you supplied and simply changed the filename to be copied but left all your syntax for the destination file. It worked as expected, it copied my specified file to the folder I selected with the Browse dialog box with the names you have typed in the above code. I also changed the Type name back to &quot;shellBrowseInfo&quot; and it also worked as expected. I am sorry I can't help you any further then this because I can't seem to find any problems with the code. The only thing I can suggest is to place some watches and evaluate the values of the variables one at a time to locate where the folder path is being lost. Please post back if you find out what is happening in your situation.



Regards,
gkprogrammer

 

[luceze]

The code posted in this link to the Access Web works great for me.

http://www.mvps.org/access/api/api0001.htm

HTH,
Eric

 

[Islwyn]

OK I've finally got it working but there must be something my OS doesn't like about the first lot of code I tried, it either crashing, freezing or giving me that initial error I had at the start.

I've ended up using the code at

http://www.mvps.org/access/api/api0001.htm

combined with the following:

Private Sub backuptoexternal_Click()

Dim strFilter As String
Dim strSaveFileName As String
Dim tablefile As String
Dim todaysdate As String
Dim queryname As String

queryname = &quot;UpdateSaveDate&quot;

todaysdate = Date$
' setup file names with dates
tablefile = &quot;PEDIGREE FLOCK TABLES &quot; & todaysdate & &quot;.mdb&quot;
'Ask for SaveFileName
strFilter = ahtAddFilterItem(strFilter, &quot;Access Files (*.mdb)&quot;, &quot;*.mdb&quot
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY, FileName:=tablefile, _
DialogTitle:=&quot;SAVE PEDIGREE FLOCK FILES&quot
MsgBox &quot;TABLES SAVED AS: &quot; & strSaveFileName
FileCopy &quot;C:\PEDIGREE FLOCK\TABLES\PEDIGREE FLOCK TABLES.mdb&quot;, strSaveFileName
DoCmd.SetWarnings (WarningsOff)
DoCmd.OpenQuery queryname, acNormal, acEdit
DoCmd.Close

End Sub

Thanks for all your time and help GKProgrammer, I've learnt a lot, and thanks for the link luceze.

Cheers

Nick