Home > Enterprise >  Zip creation based on path provided in cells
Zip creation based on path provided in cells

Time:06-21

  1. provide path of files or folder in certain range of cells.
  2. read those cells and copy those files/folder to a new folder.
  3. create a zip of that folder.

Sample input:
sample input

Sub test()
    Dim rngFile As Range, cel As Range
    Dim desPath As String, filename As String

    Set rngFile = ThisWorkbook.Sheets("Instructions").Range("A3", "A5") 

    desPath = "C:\test\"

    For Each cel In rngFile
        If Dir(cel) <> "" Then
            filename = Dir(cel) 
            FileCopy cel, desPath & filename
        End If
    Next
End Sub

I am able to read and copy files but not able to copy folder. any way such it can copy files as well as folder which is mentioned in cells.

CodePudding user response:

Try something like this:

Sub test()
    Const DEST_PATH As String = "C:\test\" 'use const for fixed values
    Dim rngFile As Range, cel As Range, p, fso As Object
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set rngFile = ThisWorkbook.Sheets("Instructions").Range("A3:A5") ' : not ,

    For Each cel In rngFile.Cells
        cel.Font.Color = vbBlack
        p = Trim(cel.Value)
        If fso.FolderExists(p) Then     'is this a folder?
            fso.copyfolder p, DEST_PATH
        ElseIf fso.FileExists(p) Then   'is this a file?
            fso.copyfile p, DEST_PATH
        Else
            cel.Font.Color = vbRed      'not an existing file or folder
        End If
    Next
End Sub
  • Related