Jump to content
Sign in to follow this  
demyz0r

Dividir em 2

Recommended Posts

demyz0r

Boa tarde, tenho este código funcionável, no entanto queria-o dividir pelo menos em duas partes, ele corre as pastas de um caminho que lhe dou, e consoante os filtros ele insere certas pastas e ficheiros num zip.

Desde já muito obrigado, tenho de melhorar e dividir melhor as funções, pois esta pode ser dividida em duas ou três diferentes.
PS: Não liguem ao nome da função porque antes eu estava a pesquisar os ficheiros por extensão.

Public Sub GetExtension()
    Dim objFSO, myFolder, mySubFolder, myFile, queue As Collection
    Dim myExtension, strZip, licensa As String
    Dim sngStart As Single
    Dim data As String
    Dim objShell, objZip, fso As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Set queue = New Collection
    queue.Add objFSO.GetFolder(Application.LicomdatPath) 'Get and define the folder object
    Set myFolder = objFSO.GetFolder(Application.LicomdatPath)
    Set mySubFolder = myFolder.SubFolders
    
    'Zip file variables and creation
    licensa = (Application.License.GetCustomerName) 'Company name
    data = Date

    Set objShell = CreateObject("Shell.Application")
    strZip = "C:\hello\Backup_" & licensa & ".zip"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objZip = fso.CreateTextFile(strZip)
    objZip.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    objZip.Close
    
            Do While queue.Count > 0
                Set myFolder = queue(queue.Count)
                queue.Remove (queue.Count)
                'loops through each file in the directory and prints their names and path
                For Each mySubFolder In myFolder.SubFolders
                    If mySubFolder.Name Like "R*" Then
                                    objShell.Namespace("" & strZip).CopyHere mySubFolder.Path
                                    sngStart = Timer
                                    Do While Timer < sngStart + 2
                                        DoEvents
                                    Loop
                    Else
                    End If
                queue.Add mySubFolder
                Next mySubFolder
                For Each myFile In myFolder.Files
                                     If myFile.Name Like "R*" Then
                                        objShell.Namespace("" & strZip).CopyHere myFile.Path
                                        sngStart = Timer
                                        Do While Timer < sngStart + 2
                                            DoEvents
                                        Loop
                                    Else
                                    End If
                Next myFile
           Loop
            MsgBox "ola"
End Sub

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.