Hi everybody,
I am using the following code to copy files from my computer to a shared folder in my network, but when i am using it, it tooks a very very long time in calculating (about 15-20 min.) each time the sheet is opening (as it reads and calculate all the data each opening time - (about 10,000 rows)
any support ?
Sub Copy_Files()
Dim cell As Range
Dim sFolderPath As String
Dim FTC As String
Dim APPRV As String
Dim oFSO As Object
Dim XLS As Object
Set XLS = ActiveWorkbook.Sheets("TO SERVER")
For Each cell In XLS.Range("I4", XLS.Range("I" & Rows.Count).End(xlUp))
sFolderPath = cell.Offset(, 1).Value
FTC = cell.Offset(, 3).Value
APPRV = cell.Offset(, 4).Value
On Error Resume Next
'Check Specified Folder exists or not
If Dir(sFolderPath) <> "" Then
'If file is available
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 2).Value
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 5).Value
Kill cell.Value
Worksheets("TO SERVER").Calculate
End If
'If folder is not available
MkDir sFolderPath
MkDir FTC
MkDir APPRV
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 2).Value
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 5).Value
Kill cell.Value
Worksheets("TO SERVER").Calculate
On Error Resume Next
Next cell
End Sub
I am using the following code to copy files from my computer to a shared folder in my network, but when i am using it, it tooks a very very long time in calculating (about 15-20 min.) each time the sheet is opening (as it reads and calculate all the data each opening time - (about 10,000 rows)
any support ?
Sub Copy_Files()
Dim cell As Range
Dim sFolderPath As String
Dim FTC As String
Dim APPRV As String
Dim oFSO As Object
Dim XLS As Object
Set XLS = ActiveWorkbook.Sheets("TO SERVER")
For Each cell In XLS.Range("I4", XLS.Range("I" & Rows.Count).End(xlUp))
sFolderPath = cell.Offset(, 1).Value
FTC = cell.Offset(, 3).Value
APPRV = cell.Offset(, 4).Value
On Error Resume Next
'Check Specified Folder exists or not
If Dir(sFolderPath) <> "" Then
'If file is available
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 2).Value
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 5).Value
Kill cell.Value
Worksheets("TO SERVER").Calculate
End If
'If folder is not available
MkDir sFolderPath
MkDir FTC
MkDir APPRV
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 2).Value
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 5).Value
Kill cell.Value
Worksheets("TO SERVER").Calculate
On Error Resume Next
Next cell
End Sub