Need Help - FileCopy Function (1 Viewer)

[feinj]

I just want to have a Macro that will copy an excel file from one external folder to another and alter the file name to include the current date.

I have exhaused all other searches and cannot find a workable solution.

I have seen and tried several examples of code, but nothing seems to work without some sort of error.

Ideally if someone could provide me with a link to a working database that has this working function, that would be the best.

Thanks in advance for your help.

 

[pbaldy]

This is from a VB6 file, but the syntax is the same in VBA:

FileCopy g_sServerPath, strUserPath

where the 2 variables contain a valid path including name.

 

[JohnLee]

Hi,

I'm no expert but with the help of the experts on this site I was able to come up with the code below, which you might find of some use.

This is my code for copying files to a new location and adding the date to the end of it. You will of course have to edit in the appropriate places [those highlighted in red for sure] for your own purposes:

This code works great for me and I can use for different file typs i.e. ".txt", ".xls", ".tif" etc

[COLOR=green][FONT=Times New Roman]'=============================================[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'References:[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Visual Basic For Applications[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft Access 9.0 Object Library[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft DAO 3.6 Object Library[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft Scripting Runtime[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'=============================================[/FONT][/COLOR]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] filenum [COLOR=blue]As[/COLOR] Integer                                                      [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] Count [COLOR=blue]As[/COLOR] Long                                                           [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] tmp [COLOR=blue]As[/COLOR] String                                                           [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] rst [COLOR=blue]As[/COLOR] DAO.Recordset                                                    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] DB [COLOR=blue]As[/COLOR] Database                                                          [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] FS [COLOR=blue]As[/COLOR] FileSystemObject                                                  [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] Folder [COLOR=blue]As[/COLOR] Folder                                                        [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] subFolder [COLOR=blue]As[/COLOR] Folder                                                     [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] File [COLOR=blue]As[/COLOR] File                                                            [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] [COLOR=red]TextFilePath[/COLOR]                                                            [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] dtmDate [COLOR=blue]As[/COLOR] Date                                                         [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] dtmFileDate [COLOR=blue]As[/COLOR] Date                                                     [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] TextFileDate                                                            [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] NameOfFile                                                              [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] FileNameWithExt                                                         [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] strTemp [COLOR=blue]As[/COLOR] String                                                       [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] FileLoc [COLOR=blue]As[/COLOR] String                                                       [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Const[/COLOR] ForReading = 1                                                        [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] DB = CurrentDb                                                          [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] FS = CreateObject("Scripting.FileSystemObject")                         [/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    dtmDate = Date                                                              [/FONT]
[FONT=Times New Roman]    [COLOR=red]TextFilePath[/COLOR] = "[COLOR=red]B[/COLOR]:\"                           [COLOR=green]'Set the text file path here [the location where text files are be stored][/COLOR][/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]If Not[/COLOR] FS.FolderExists([COLOR=red]TextFilePath[/COLOR]) [COLOR=blue]Then[/COLOR]                                   [COLOR=green]'If we can't read the text file folder, stop running[/COLOR][/FONT]
[FONT=Times New Roman]        MsgBox "Folder Doesn't Exist", , "Reading Text Files"[/FONT]
[FONT=Times New Roman]        [COLOR=blue]End[/COLOR][/FONT]
[FONT=Times New Roman]    [COLOR=blue]End If[/COLOR][/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] Folder = FS.GetFolder([COLOR=red]TextFilePath[/COLOR])                                          [COLOR=green]'Open the text file folders[/COLOR][/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]For Each[/COLOR] subFolder In Folder.SubFolders                                          [COLOR=green]'Loops through the Folders looking for SubFolders[/COLOR][/FONT]
[FONT=Times New Roman]        [COLOR=blue]For Each[/COLOR] File In subFolder.Files                                                     [COLOR=green]'Loops through Subfolders looking for Files[/COLOR][/FONT]
[FONT=Times New Roman]            [COLOR=blue]If[/COLOR] Right(File.Name, 4) = ".[COLOR=red]txt[/COLOR]" [COLOR=blue]Then[/COLOR]                                          [COLOR=green]'If the file found has a ".[/COLOR][COLOR=red]txt[/COLOR][COLOR=green]" extension then[/COLOR][/FONT]
[FONT=Times New Roman]                FileNameWithExt = Mid$(File.Name, InStrRev(File.Name, "\") + 1)[/FONT]
[FONT=Times New Roman]                strTemp = Mid$(File.Name, InStrRev(File.Name, "\") + 1)         [/FONT]
[FONT=Times New Roman]                NameOfFile = Left$(strTemp, InStrRev(strTemp, ".") - 1)         [/FONT]
[FONT=Times New Roman]                subFilePath = Left$(subFolder, InStrRev(subFolder, "\"))        [/FONT]
[FONT=Times New Roman]                SubFolderName = Mid$(subFolder, InStr(3, subFolder, "\"))       [/FONT]
[FONT=Times New Roman]                FileLoc = subFolder & "\" & File.Name [/FONT]
[FONT=Times New Roman]                [/FONT]
[FONT=Times New Roman]                [COLOR=blue]If[/COLOR] Dir("[COLOR=red]G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01[/COLOR]" & SubFolderName, vbDirectory) = "" [COLOR=blue]Then[/COLOR]  [/FONT]
[FONT=Times New Roman]                    MkDir ("[COLOR=red]G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01[/COLOR]" & SubFolderName)                     [/FONT]
[FONT=Times New Roman]                    FS.CopyFile subFolder & "\" & FileNameWithExt, "[COLOR=red]G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01[/COLOR]" & SubFolderName & "\" & NameOfFile & "_" & Format(Date, "ddmmyy") & ".[COLOR=red]txt[/COLOR]"   [/FONT]
[FONT=Times New Roman]                [COLOR=blue]Else                                                                                            [/COLOR][/FONT]
[FONT=Times New Roman]                    FS.CopyFile subFolder & "\" & FileNameWithExt, "G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01" & SubFolderName & "\" & NameOfFile & "_" & Format(Date, "ddmmyy") & ".[COLOR=red]txt[/COLOR]"   [/FONT]
[FONT=Times New Roman]                [COLOR=blue]End If[/COLOR][/FONT]
[FONT=Times New Roman]        [COLOR=blue]Next[/COLOR][/FONT]
[FONT=Times New Roman]   [COLOR=blue]Next[/COLOR][/FONT]

Regards

John

 

[JohnLee]

Hi,

I have another slice of code that you might also find of use particularly if you are only targetting one file which will always have the same name. Again you will need to edit in the appropriate places to change the code to meet your needs.

The following code checks to see if the text files exists and then appends the contents of one to the other and then copies that text file to the required location, if only one text files exists it just copies the file that does exist to the required location adding the date at the end of course in each case.

[FONT=Times New Roman][COLOR=blue]If[/COLOR] FS.FileExists("B:\rtmail\rtmail.txt") = [COLOR=blue]True Then[/COLOR]                              [COLOR=green]'Checks to see if the rtmail.txt file exists in the B:\rtmail folder, if it does then[/COLOR][/FONT]
[FONT=Times New Roman]        [COLOR=blue]If[/COLOR] FS.FileExists("B:\rtmail.fof\rtmail.txt") = [COLOR=blue]True Then[/COLOR] [COLOR=green]'Checks to see if the rtmail.txt file exists in the B:\rtmail.fof folder, if it does then[/COLOR][/FONT]
[FONT=Times New Roman]    [/FONT]
[FONT=Times New Roman]            [COLOR=blue]Dim[/COLOR] SourceNum [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]        [COLOR=green]'Declare the SourceNum variable as Integer[/COLOR][/FONT]
[FONT=Times New Roman]            [COLOR=blue]Dim[/COLOR] DestNum [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]           [COLOR=green]'Declare the DestNum variable as Integer[/COLOR][/FONT]
[FONT=Times New Roman]        [/FONT]
[FONT=Times New Roman]            DestNum = FreeFile()                                [COLOR=green]'Open the destination text file[/COLOR][/FONT]
[FONT=Times New Roman]            Open "B:\rtmail.fof\rtmail.txt" For Append As DestNum[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]            SourceNum = FreeFile()             [COLOR=green]'Open the source text file[/COLOR][/FONT]
[FONT=Times New Roman]            [COLOR=blue]Open[/COLOR] "B:\rtmail\rtmail.txt" [COLOR=blue]For Input[/COLOR] As SourceNum[/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]            [COLOR=blue]Do While Not[/COLOR] EOF(SourceNum)               [COLOR=green]'Read each line of the source file and append it to the destination file[/COLOR][/FONT]
[FONT=Times New Roman]                [COLOR=blue]Line Input[/COLOR] #SourceNum, Temp[/FONT]
[FONT=Times New Roman]                [COLOR=blue]Print[/COLOR] #DestNum, Temp[/FONT]
[FONT=Times New Roman]            [COLOR=blue]Loop[/COLOR][COLOR=blue][/COLOR][/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]            [COLOR=blue]Close[/COLOR] #DestNum        [COLOR=green]'Close the Destinationtext file[/COLOR][/FONT]
[FONT=Times New Roman]            [COLOR=blue]Close[/COLOR] #SourceNum     [COLOR=green]'Close the Source text file[/COLOR][/FONT]
[FONT=Times New Roman]            [/FONT]
[FONT=Times New Roman]            Kill "B:\rtmail\rtmail.txt"[/FONT]
[FONT=Times New Roman]        [COLOR=blue]Else[/COLOR][/FONT]
[FONT=Times New Roman]             [COLOR=blue]If[/COLOR] FS.FileExists("B:\rtmail\rtmail.txt") = [COLOR=blue]True Then[/COLOR]      [COLOR=green]'If the rtmail.txt file exists then[/COLOR][/FONT]
[FONT=Times New Roman]                [COLOR=green]'Copy the Return Mail text file to the new Folder[/COLOR][/FONT]
[FONT=Times New Roman]                FS.CopyFile "B:\rtmail\rtmail.txt", "B:\rtmail.fof\rtmail” & "_" & Format(Date, "ddmmyy") &”.txt"                [/FONT]
[FONT=Times New Roman]                Kill "B:\rtmail\rtmail.txt"   [COLOR=green]'Delete the rtmail.txt file from the rtmail folder[/COLOR][/FONT]
[FONT=Times New Roman]            [COLOR=blue]End If[/COLOR][/FONT]
[COLOR=blue][FONT=Times New Roman]        End If[/FONT][/COLOR]
[COLOR=blue][FONT=Times New Roman]    End If[/FONT][/COLOR]

I hope this helps.

Regards

John

 

[feinj]

JohnLee,

I tried the second of the two options you provided and I get a Run-time error '424', Object Required.

On First Line of Code, under definition I get the following message:
Identifier under cursor is not recognized.

See my code below:

Private Sub CopyFile_Click()
If FS.FileExists("D:\rtmail\rtmail.txt") = True Then 'Checks to see if the rtmail.txt file exists in the B:\rtmail folder, if it does then
If FS.FileExists("D:\rtmail.fof\rtmail.txt") = True Then 'Checks to see if the rtmail.txt file exists in the B:\rtmail.fof folder, if it does then
Dim SourceNum As Integer 'Declare the SourceNum variable as Integer
Dim DestNum As Integer 'Declare the DestNum variable as Integer
DestNum = FreeFile() 'Open the destination text file
Open "D:\rtmail.fof\rtmail.txt" For Append As DestNum
SourceNum = FreeFile() 'Open the source text file
Open "D:\rtmail\rtmail.txt" For Input As SourceNum
Do While Not EOF(SourceNum) 'Read each line of the source file and append it to the destination file
Line Input #SourceNum, Temp
Print #DestNum, Temp
Loop
Close #DestNum 'Close the Destinationtext file
Close #SourceNum 'Close the Source text file
Kill "D:\rtmail\rtmail.txt"
Else
If FS.FileExists("D:\rtmail\rtmail.txt") = True Then 'If the rtmail.txt file exists then
'Copy the Return Mail text file to the new Folder
FS.CopyFile "D:\rtmail\rtmail.txt", "D:\rtmail.fof\rtmail.txt"
Kill "D:\rtmail\rtmail.txt" 'Delete the rtmail.txt file from the rtmail folder
End If
End If
End If
End Sub

 

[JohnLee]

Hi,

Check that you have the references set see below:

[FONT=Times New Roman][COLOR=#008000]'=============================================[/COLOR][/FONT]
[COLOR=green][FONT=Times New Roman]'References:[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Visual Basic For Applications[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft Access 9.0 Object Library[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft DAO 3.6 Object Library[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'Microsoft Scripting Runtime[/FONT][/COLOR]
[COLOR=green][FONT=Times New Roman]'=============================================[/FONT][/COLOR]

At the very least you need to haveboth the DAO 3.6 Object Library and the Scripting Runtime references set.

Whe in the module design click on the "Tools" menu and select "references" a pop up window will appear, ensure that these two references are checked.

Regards

John