обновление файла в подпапках одной папки vba - PullRequest
Новая
       18

обновление файла в подпапках одной папки vba

0 голосов
/ 02 июня 2018

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

source
D:\home
destination
D:\dest\cus1\...

В настоящее время я использую приведенный ниже код, но мне нужно улучшить хотя бы цикл или любой новыйалгоритм.Можете ли вы помочь? 

Sub sbCopyingAllExcelFiles()

    Dim FSO
    Dim sFolder As String
    Dim dFolder As String

    sFolder = "c:\Users\osmanerc\Desktop\STATUS\" ' change to match the source folder path
    dFolder = "\\manfile\ELEKTRONIK\MUSTERI DESTEK\ECN management\" ' change to match the destination folder path
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(sFolder) Then
        MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
    ElseIf Not FSO.FolderExists(dFolder) Then
        MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
    Else
        FSO.CopyFile (sFolder & "\*.xl*"), dFolder
        MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
    End If
End Sub

1 Ответ

0 голосов
/ 05 июня 2018

Таким образом, вы сможете скопировать все файлы из вашего источника, которые соответствуют шаблону Like sFolder & "\*.xl*".Вы можете добавить больше звонков, если у вас есть больше папок для работы. 

Sub sbCopyingAllExcelFiles()

    Call SafeCopy("c:\Users\osmanerc\Desktop\STATUS\", "\\manfile\ELEKTRONIK\MUSTERI DESTEK\ECN management\")
    'Call SafeCopy("another source folder", "another destination folder")
    'Add more function calls as necessary

End Sub

Function SafeCopy(ByVal sFolder As String, ByVal dFolder As String)

    Dim count As Integer

    Dim FSO As Object
    Dim Folder As Object
    Dim File As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(sFolder) Then
        MsgBox "Source Folder Not Found: " & vbCrLf & sFolder, vbInformation, "Source Not Found!"
        Exit Function
    ElseIf Not FSO.FolderExists(dFolder) Then
        MsgBox "Destination Folder Not Found: " & vbCrLf & dFolder, vbInformation, "Destination Not Found!"
        Exit Function
    Else
        Set Folder = FSO.GetFolder(sFolder)

        For Each File In Folder.Files
            If File.Name Like sFolder & "\*.xl*" Then
                FSO.CopyFile File.path, dFolder
                count = count + 1
            End If
        Next

        MsgBox "Copied " & count & "files to destination", vbInformation, "Copy Successful"
    End If

End Function
...