Как добавить код для удаления старого файла, если скопированный файл FSO новее, чем файл в папке назначения? - PullRequest
Новая
       31

Как добавить код для удаления старого файла, если скопированный файл FSO новее, чем файл в папке назначения?

0 голосов
/ 10 октября 2019

Я пишу код VBA, чтобы извлечь файл из исходной папки и перейти в мою папку, чтобы проанализировать его, чтобы не повредить исходный файл. Но я сталкиваюсь с трудностями при написании кода, который заменит старый файл, если обнаружит, что имя совпадает. 

Private Sub CommandButton1_Click()
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim datasource As Workbook
Dim target As Worksheet
Dim strName As String
Dim lastrow As Long
Dim userinput As String

userinput = InputBox(Prompt:="Please key in the file name and format", Title:=" File name", Default:=".xlsm") 'This is Your File Name which you want to Copy
sSFolder = "J:\Inter Dept\MP8 Packaging\2.0 MP8.1\B2-Machine Data Tracking\B2-Machine Data Tracking 2019\" 'Change to match the source folder path
sDFolder = "C:\Users\limmigmy\Desktop\Rejection Report\Rejection\Packing Analysis\Production Files\" 'Change to match the destination folder path

Set FSO = CreateObject("Scripting.FileSystemObject") 'Create Object

If Not FSO.FileExists(sSFolder & userinput) Then 'Checking If File Is Located in the Source Folder
    MsgBox "Specified File Not Found", vbInformation, "Not Found"

ElseIf Not FSO.FileExists(sDFolder & userinput) Then 'Copying If the Same File is Not Located in the Destination Folder
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
**Else
    MsgBox "Specified File Already Exists In The Destination Folder",** vbExclamation, "File Already Exists"
End If

1 Ответ

0 голосов
/ 10 октября 2019

Мне кажется, я знаю, что вы имеете в виду, это просто «Но я сталкиваюсь с трудностями при написании кода, который заменяет старый файл, если обнаружит, что имя совпадает». Это немного сбивает с толку.

Проверьте, посмотрите, поможет ли это, во что бы то ни стало, вы можете порезать и изменить его. Это происходит немного иначе, но работает как положено. 

        Sub CopyFileIfOlder()
        'declare your variables
        Dim strFilePathOne As String, FileDateOne As Date, FileOneLoc As String
        Dim strFilePathTwo As String, FileDateTwo As Date, FileTwoLoc As String

        'set your file paths to the two different files
        strFilePathOne = "C:\VBNET Test Area\StackOverFlow\File1.txt"
        strFilePathTwo = "C:\VBNET Test Area\File1.txt"

        'declare and set your objects
        Dim oFSO As Object
            Set oFSO = CreateObject("Scripting.FileSystemObject")
        Dim oFile1 As Object
            Set oFile1 = oFSO.GetFile(strFilePathOne)
        Dim oFile2 As Object
            Set oFile2 = oFSO.GetFile(strFilePathTwo)

        'grabs your files modified dates : grabs your files dir location not inc filename
        FileDateOne = oFile1.DateLastModified: FileOneLoc = oFile1.Path
        FileDateTwo = oFile2.DateLastModified: FileTwoLoc = oFile2.Path

        'sets an error handler incase anything goes wrong copying
        On Error GoTo FileDeleteAndCopyError

            'tests to see if file1 is older
            If FileDateOne < FileDateTwo Then
                'file one is older
                Kill strFilePathOne 'deletes file1
                    FileCopy strFilePathTwo, FileOneLoc 'copies the newer version into older files place
            Else
                'file two is newer
                Debug.Print "FILE ONE IS NEWER THAN FILE TWO SO I WONT DO ANYTHING" 'PRINTS A MESSAGE SAYING NO COPY HAS BEEN DONE
            End If

        'RETURNS ERROR HANDLER TO NORMAL
        On Error GoTo 0

        'EXITS SUB BECAUSE IF NOT THE ERROR HANDLER WILL FIRE
        Exit Sub

        'ERROR HANDLER INCASE FILE COPY GOES WRONG
   FileDeleteAndCopyError:
            MsgBox "There has been an error!", vbCritical

        End Sub
...