agent_maxine
New Member
- Joined
- Aug 23, 2017
- Messages
- 38
Dear Mr. Excel,
After days of searching for answers to no avail, I thought I'd reach out to you. Any help will be greatly appreciated!
I am trying to accomplish the following:
I started with Ron de Bruin's codes then tried to add additional features... I am currently getting an error message:
After days of searching for answers to no avail, I thought I'd reach out to you. Any help will be greatly appreciated!
I am trying to accomplish the following:
- I have a column (from Cell C54 to C105) that displays the file names (they are results of formulas). Some of them contain null string "".
- My DocRange then is only the cells that contain results other than null string.
- Then it needs to copy all the files in FromPath with same file names as the cell values within DocRange.
- It pastes these files into ToPath.
- It also creates a single, combined Word document that merges/appends all the DOCX files.
- It creates a single, combined PDF document for all the copied files.
I started with Ron de Bruin's codes then tried to add additional features... I am currently getting an error message:
Error Message = "Run-time error 53: File Not Found"
Code:
Sub Copy_Files()
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite existing files in this folder
Dim FromPath As String, ToPath As String, FileExt As String
Dim Company As String
Company = Cells(1, 3).Value
FromPath = Application.ActiveWorkbook.Path & "\" & Company
ToPath = Application.ActiveWorkbook.Path & "\Forms\"
If Right(ToPath, 1) <> "\" Then
ToPath = ToPath & "\"
End If
Dim DocRange As Range
Set DocRange = Range("C54:C105").SpecialCells(xlCellTypeVisible)
FileExt = "*.*"
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CreateFolder (ToPath)
For Each c In DocRange
If Not IsNull(cell.Value) Then
File = Dir(FromPath & FileExt)
While (File <> "")
FileCopy FromPath & File, ToPath & File
File = Dir
Wend
Else
End If
Next
'FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "Applicable Forms have been copied into the Folder " & ToPath & "."
End Sub