Add "Where to Save to Prompt" in FileCopy

[misternumbertwo]

Hi everyone, I am a novice VBA user and currently fixing an old database that produces instructions for freight and shipping. The database outputs an excel file that is copied from a template using the function FileCopy.

Now my question is can how can I add a function that will prompt the user where to save/export the files that will be generated?

I am currently using this format to copy the file.
Dim SourceFile, DestinationFile As String
SourceFile = "SRCFILE" ' Define source file name.
DestinationFile = "DESTFILE" ' Define target file name.
FileCopy(SourceFile, DestinationFile) ' Copy source to target.

What portions of the code I need to change? Any help would be very much appreciated.Thanks

 

[jal]

This question comes up all the time. Do you want the user to select a FILE or a FOLDER? If a folder, then do this:

(Add a REference to Microsoft Shell Controls and automation)

Dim shell1 As New Shell32.Shell, pathToFolder As String
pathToFolder = shell1.BrowseForFolder(0, "Choose a folder", 0).self.Path
MsgBox (pathToFolder)

Or use latebinding (no reference needed).

Dim pathToFolder As String, oShell As Object
Set oShell = CreateObject("Shell.Application")
pathToFolder = oShell.BrowseForFolder(0, "Choose a folder", 0).self.Path
MsgBox (pathToFolder)
Set oShell = Nothing

If you want a FILE then you can use this (it looks intimidating but it is ready-to-go - just call the function as needed). The declarations need to be at the top of your code.

[SIZE=2]
Sample filter string - this one for excel files (the Chr(0) functions like the vertical bar in VB.Net filters). 
Dim filter As String
filter = "Excel files(*.xls)" & Chr(0) & "*.xls" & Chr(0) & "All Files (*.*)" & Chr(0) & "*.*"
and one for JPEG files:
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
"JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
Public Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
 
Public Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
 
'Pass in a boolean indicating whether this is a SaveFileDialog. If false, it will be an open fileEDialog.
Private Function ShowFileDialog(ByVal SaveFileDialog As Boolean, strFilter As String, strTitle As String, ByVal strInitialDirec As String)
Dim OFN As tagOPENFILENAME
Dim strFileName As String, strFileTitle As String
strFileName = VBA.Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
With OFN
.lStructSize = Len(OFN)
'.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = 0
.strFile = VBA.Left(strFileName & String(256, 0), 256)
.nMaxFile = VBA.Len(strFileName)
.strFileTitle = String(256, 0)
.nMaxFileTitle = VBA.Len(strFileTitle)
.strTitle = strTitle
.Flags = 0
.strDefExt = ""
.strInitialDir = strInitialDirec
.strCustomFilter = ""
.nMaxCustFilter = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
If SaveFileDialog Then aht_apiGetSaveFileName OFN Else aht_apiGetOpenFileName OFN
'The string returned is 256 chars long, ending in nulls. Remove the nulls.
ShowFileDialog = OFN.strFile
If VBA.Len(OFN.strFile & "") = 0 Then Exit Function
Dim i As Long
For i = VBA.Len(OFN.strFile) To 1 Step -1
If VBA.Mid(OFN.strFile, i, 1) <> Constants.vbNullChar Then Exit For
Next i
ShowFileDialog = VBA.Mid(OFN.strFile, 1, i)
End Function
 
[/SIZE]

 

[misternumbertwo]

Thanks for the reply jal. I'm gonna if any of the to will work.

One question though, do you think this will still work even if the MS Access database that I'm building will be placed in a Sharepoint Server?

Thanks again.

 

[jal]

I know nothing about SharePoint server. However, if this entails a web application then I can imagine the dialogs might not work. I'm guessing that OpenFileDialogs were mostly intended for Windows Forms apps, not web applications.