Copy a file from one location to another... 1

[EdwardMartinIII]

I have a form. The form has one button, labeled "Include a file...".

I would like to be able to have the User click that button. A "Browse for file" window pops open and lets 'em select some file from their hard drive. When they click "Accept", the browse window closes and my code copies the file they selected to a completely different location somewhere on the network (a special location that never changes), changing the name of the file by appending some fabricated suffix to the front of it.

For example, you browse to the file "ErrorTracking.psd" on your desktop. After you press "Accept", your file still exists, but a COPY of it also exists in a network drive called "Arc20030117a_ErrorTracking.psd". And I'll pop up a little notice window after the copy is complete, reading "File copied!"

I'm thinking

 Dim SourceFile, DestinationFile
 SourceFile = "SRCFILE"    ' Define source file name.
 DestinationFile = "SampleCopy"    ' Define target file name.
 FileCopy SourceFile, DestinationFile    ' Copy source to target.

but I have no idea how I'd browse to populate SourceFile...

Advice?

Thanks!

Edward "Do not read this sentence."

 

[BillPower]

Create a new module, paste the following into it:

Option Compare Database
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
strFilter As String
lngFilterIndex As Long
strInitialDir As String
strInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
strFullPathReturned As String
strFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & &quot;*.*&quot; & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = &quot;&quot;
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = &quot;&quot;
intNum = 0
intPos = 1
intLastPos = 1
Do
intPos = InStr(intLastPos, strFilterIn, &quot;|&quot
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
If intNum Mod 2 = 1 Then
strFilter = strFilter & &quot;*.*&quot; & vbNullChar
End If
If strFilter <> &quot;&quot; Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_tF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = &quot;&quot; Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub

Function Find_File(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = &quot;Select A File&quot; 'edit this
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString(&quot;Files&quot;, &quot;*.*&quot 'edit this
MSA_GetOpenFileName msaof
Find_File = Trim(msaof.strFullPathReturned)
End Function

To test it, paste this into the on click event of a button:

Dim strFile As String
strFile = &quot;c:\My Documents&quot; 'folder to start in
MsgBox Find_File(strFile) 'message displaying file selected

To use it in your scenario, try:
strFile =&quot;c:\&quot;
SourceFile = Find_File(strFile)
DestinationFile= Find_File(strFile)
FileCopy SourceFile, DestinationFile ' Copy source to target.

 

[EdwardMartinIII]

Holy smokes! All that, just to browse for a file path and name?!

I've gotta run through this and see what's happening in it. I expected basically three or four lines. Hm...

thanks,

Edward &quot;Do not read this sentence.&quot;

 

[chrissie1]

sorry bill but if he is using access 2000 and above then try this

Private Sub btn_browse_Click()
Dim dlgopen As FileDialog

Set dlgopen = Application.FileDialog(msoFileDialogFilePicker)

dlgopen.AllowMultiSelect = False
dlgopen.Filters.Add &quot;Excell file&quot;, &quot;*.xls&quot;, 1
dlgopen.Show

invoice = dlgopen.SelectedItems(1)
End Sub

but bills code works just as well
Christiaan Baes
Belgium
&quot;What a wonderfull world&quot; - Louis armstrong

 

[EdwardMartinIII]

Okay Bill,

This worked out really nicely. I'm amazed at the size of the code necessary, but who am I to tinker with it -- it works!

Thanks!

Edward &quot;Do not read this sentence.&quot;