Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need Help with copy/paste files 2

Status
Not open for further replies.

BubbaJean

IS-IT--Management
Jun 5, 2002
111
US
I have a textbox on a form (access2000)that pulls in files from the users C dirve i.e. C:\COdescassy.pdf, now I need a button that will save the pdf drawings into another director as well as the path name
this is what I have so far
Unbound text box called "txtFileOpen" = C:\COdescassy.pdf

bound text box:
DataSheet1X C:\COdescassy1.pdf
DataSheet2X C:\COdescassy2.pdf
DataSheet3X C:\COdescassy3.pdf
DataSheet4X C:\COdescassy4.pdf
Idealy when the user click on Move Files Button it should copy the drawing to a new director and save the new path in the table i.e.,
DataSheet1X D:\COdescassy1.pdf
DataSheet2X D:\COdescassy2.pdf
DataSheet3X D:\COdescassy3.pdf
DataSheet4X D:\COdescassy4.pdf

I spend a couple of days reading about Microsoft Scripting Runtime and FileSystemObject but I'm so lost
Hope someone can help me out.

 
You can use this code to copy and paste files:

Option Compare Database
Option Explicit

Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10


Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long


Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type


Dim x As SHFILEOPSTRUCT

Private Sub Command3_Click()

x.pFrom = "C:\COdescassy4.pdf"
x.pTo = "D:\COdescassy4.pdf"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x

MsgBox "Copy Complete.", vbOKOnly

End sub

You can pass the paths to the x.pFrom and x.pTo variables.

See if that will get you started.

HTH,
Eric
 
I get the follwing error "Complie error: ONly comments may appear after End Sub, End Functon, or End Property
then it highlight
"
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long"
 

Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10




Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long


Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type


Dim x As SHFILEOPSTRUCT

Private Sub Command3_Click()
x.pFrom = "C:\COdescassy4.pdf"
x.pTo = "D:\COdescassy4.pdf"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x

MsgBox "Copy Complete.", vbOKOnly

End Sub

'You can pass the paths to the x.pFrom and x.pTo variables.
 
Try this, I had two lines switched.


Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10




Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long


Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Sub Command3_Click()

Dim x As SHFILEOPSTRUCT

x.pFrom = "C:\COdescassy4.pdf"
x.pTo = "D:\COdescassy4.pdf"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x

MsgBox "Copy Complete.", vbOKOnly

End Sub
 
no, I'm still getting the same error 4 lines down, should I place code in the form open or form current??

Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long


Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Sub Command3_Click()

Dim x As SHFILEOPSTRUCT

x.pFrom = "C:\COdescassy4.pdf"
x.pTo = "D:\COdescassy4.pdf"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x

MsgBox "Copy Complete.", vbOKOnly

End Sub
 
Create a button. Go to the on click event in the VB editor. Before the Private Sub line add this part of the code:


''StartCode
Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
''EndCode


After the Private Sub line add this part of the code:

''StartCode
Dim x As SHFILEOPSTRUCT

x.pFrom = "C:\COdescassy4.pdf"
x.pTo = "D:\COdescassy4.pdf"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x

MsgBox "Copy Complete.", vbOKOnly

''EndCode


Or if you prefer you can send me a copy of the D-base (minus any sensitive data) and I will code it and send it back to you. eisom@esc11.net
 
jwhjr or Luceze, do either of you have a simple db eample of how your code works??
 
Here's a function I wrote that uses the copy file that I referenced in the FAQ:

Function moveAndCopyFile()
'Function moveAndCopyFile() finds the appropriate file, moves it to a new folder to with
'the current date and then creates a copy that is in .txt format to be imported into the
'database, it then calls the import file function to finalize the process and import the files

Dim fso As FileSystemObject
'files to transfer and import, if the file names or locations ever change they will need
'to be changed here
Dim file1, file2, file3, file4 As String
file1 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmch.dat"
file2 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmus.dat"
file3 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmch.dat"
file4 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmus.dat"

Set fso = CreateObject("Scripting.FileSystemObject")

'Verify files exist
If Not fso.FileExists(file1) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function

ElseIf Not fso.FileExists(file2) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function

ElseIf Not fso.FileExists(file3) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function

ElseIf Not fso.FileExists(file4) Then
MsgBox "Files are not there, please verify they are there and try another time.", _
vbInformation, "File Not Found"
Exit Function

Else

'Files exist, create folder with the current date
Dim fsoFolder
Dim fol As String
fol = "V:\Corp\ACCT\900220\CC\Post Audit\Download Info\VCB RGM Detail\" _
& Format(Now, "yyyy-mm-dd")

Set fsoFolder = CreateObject("Scripting.FileSystemObject")

'create folder only if it doesn't already exist
If Not fso.FolderExists(fol) Then
fsoFolder.CreateFolder (fol)
Else
MsgBox fol & " already exists, this process has already been done!", _
vbExclamation, "Folder Exists"
Exit Function
End If

'move the files into the newly created folder and make a copy in .txt format
fso.MoveFile file1, fol & "\" & Right(file1, 10)
fso.copyFile fol & "\" & Right(file1, 10), fol & "\" & "rgmmch.txt"
fso.MoveFile file2, fol & "\" & Right(file2, 10)
fso.copyFile fol & "\" & Right(file2, 10), fol & "\" & "rgmmus.txt"
fso.MoveFile file3, fol & "\" & Right(file3, 10)
fso.copyFile fol & "\" & Right(file3, 10), fol & "\" & "vcbmch.txt"
fso.MoveFile file4, fol & "\" & Right(file4, 10)
fso.copyFile fol & "\" & Right(file4, 10), fol & "\" & "vcbmus.txt"
End If

'call function to do the import portion
importFiles

'delete the .txt files that were created and keep the original .dat files
fso.DeleteFile fol & "\" & "rgmmch.txt"
fso.DeleteFile fol & "\" & "rgmmus.txt"
fso.DeleteFile fol & "\" & "vcbmch.txt"
fso.DeleteFile fol & "\" & "vcbmus.txt"

'log successful import process
logUserAccess

'all processes have completed successfully, notify the user
MsgBox "File Copy and Import Complete", vbInformation, "Process Complete"

End Function
 
I added the above code to my form, just below my Commond Button to get files. How do I trigger your code to do its thing
I created a button called cmdImportFiles

*******Old but works code*******************************
Private Sub cmdFileOpen_Click()

' Test the CommonDlg class' FileOpen common dialog.

Dim cdl As CommonDlg
Set cdl = New CommonDlg

cdl.hWndOwner = Me.hWnd
cdl.CancelError = True

On Error GoTo HandleErrors

' Set three pairs of values for the Filter.
cdl.Filter = _
"Adobe Acrobat Document (*.pdf)|" & _
"*.pdf|" & _
"Database files (*.mdb, *.mde, *.mda)|" & _
"*.mdb;*.mde;*.mda|" & _
"All files (*.*)|" & _
"*.*"

' Select filter 1 (DataShete files) when
' the dialog opens.
cdl.FilterIndex = 1

' Indicate that you want to use a callback function,
' change back to the original directory when
' you're done, and require that the selected
' file actually exist.
cdl.OpenFlags = cdlOFNEnableHook Or _
cdlOFNNoChangeDir Or cdlOFNFileMustExist

' Select the callback function.
cdl.CallBack = adhFnPtrToLong(AddressOf GFNCallback)

' Set up miscellaneous properties.
cdl.InitDir = "C:\"
cdl.FileName = "autoexec.pdf"
cdl.DefaultExt = "pdf"

' Open the file open dialog box,
' and wait for it to be dismissed.
cdl.ShowOpen

' Retrieve the selected file na
txtFileOpen = cdl.FileName

' Check the OpenFlags (or Flags) property to
' see if the selected extension is different than
' the default extension.
If (cdl.OpenFlags And _
cdlOFNExtensionDifferent) <> 0 Then
MsgBox &quot;You chose a different extension!&quot;
End If

ExitHere:
Set cdl = Nothing
Exit Sub

HandleErrors:
Select Case Err.Number
Case cdlCancel
' Cancelled!
Resume ExitHere
Case Else
MsgBox &quot;Error: &quot; & Err.Description & _
&quot;(&quot; & Err.Number & &quot;)&quot;
End Select
Resume ExitHere
End Sub

''''''''''''''NewCode'''''''''''''''''''''''''''''''''''
Function moveAndCopyFile()
'Function moveAndCopyFile() finds the appropriate file, moves it to a new folder to with
'the current date and then creates a copy that is in .txt format to be imported into the
'database, it then calls the import file function to finalize the process and import the files

Dim fso As FileSystemObject
'files to transfer and import, if the file names or locations ever change they will need
'to be changed here
Dim file1, file2, file3, file4 As String
file1 = &quot;W:\Corp\ACCT\900020\APPS\VNDERR\rgmmch.dat&quot;
file2 = &quot;W:\Corp\ACCT\900020\APPS\VNDERR\rgmmus.dat&quot;
file3 = &quot;W:\Corp\ACCT\900020\APPS\VNDERR\vcbmch.dat&quot;
file4 = &quot;W:\Corp\ACCT\900020\APPS\VNDERR\vcbmus.dat&quot;

Set fso = CreateObject(&quot;Scripting.FileSystemObject&quot;)

'Verify files exist
If Not fso.FileExists(file1) Then
MsgBox &quot;Files are not there, please verify they are there and try another time.&quot;, _
vbInformation, &quot;File Not Found&quot;
Exit Function

ElseIf Not fso.FileExists(file2) Then
MsgBox &quot;Files are not there, please verify they are there and try another time.&quot;, _
vbInformation, &quot;File Not Found&quot;
Exit Function

ElseIf Not fso.FileExists(file3) Then
MsgBox &quot;Files are not there, please verify they are there and try another time.&quot;, _
vbInformation, &quot;File Not Found&quot;
Exit Function

ElseIf Not fso.FileExists(file4) Then
MsgBox &quot;Files are not there, please verify they are there and try another time.&quot;, _
vbInformation, &quot;File Not Found&quot;
Exit Function

Else

'Files exist, create folder with the current date
Dim fsoFolder
Dim fol As String
fol = &quot;V:\Corp\ACCT\900220\CC\Post Audit\Download Info\VCB RGM Detail\&quot; _
& Format(Now, &quot;yyyy-mm-dd&quot;)

Set fsoFolder = CreateObject(&quot;Scripting.FileSystemObject&quot;)

'create folder only if it doesn't already exist
If Not fso.FolderExists(fol) Then
fsoFolder.CreateFolder (fol)
Else
MsgBox fol & &quot; already exists, this process has already been done!&quot;, _
vbExclamation, &quot;Folder Exists&quot;
Exit Function
End If

'move the files into the newly created folder and make a copy in .txt format
fso.MoveFile file1, fol & &quot;\&quot; & Right(file1, 10)
fso.CopyFile fol & &quot;\&quot; & Right(file1, 10), fol & &quot;\&quot; & &quot;rgmmch.txt&quot;
fso.MoveFile file2, fol & &quot;\&quot; & Right(file2, 10)
fso.CopyFile fol & &quot;\&quot; & Right(file2, 10), fol & &quot;\&quot; & &quot;rgmmus.txt&quot;
fso.MoveFile file3, fol & &quot;\&quot; & Right(file3, 10)
fso.CopyFile fol & &quot;\&quot; & Right(file3, 10), fol & &quot;\&quot; & &quot;vcbmch.txt&quot;
fso.MoveFile file4, fol & &quot;\&quot; & Right(file4, 10)
fso.CopyFile fol & &quot;\&quot; & Right(file4, 10), fol & &quot;\&quot; & &quot;vcbmus.txt&quot;
End If


'call function to do the import portion
ImportFiles

'delete the .txt files that were created and keep the original .dat files
fso.DeleteFile fol & &quot;\&quot; & &quot;rgmmch.txt&quot;
fso.DeleteFile fol & &quot;\&quot; & &quot;rgmmus.txt&quot;
fso.DeleteFile fol & &quot;\&quot; & &quot;vcbmch.txt&quot;
fso.DeleteFile fol & &quot;\&quot; & &quot;vcbmus.txt&quot;

'log successful import process
logUserAccess

'all processes have completed successfully, notify the user
MsgBox &quot;File Copy and Import Complete&quot;, vbInformation, &quot;Process Complete&quot;

End Sub

Private Sub cmdImportFiles_Click()
'how do I trigger the above events?
End Sub
 
Place the function name in your click event for the button.

Private Sub cmdImportFiles_Click()
moveAndCopyFile
End Sub
 
I sent the file back let me know if that's what you want or if you need more info.

Eric
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top