U
u473
The task : Copy all "Cost Summary" Sheets values from all WB's in
Folder A to Folder B.
..
If Folder B does not exists, create it and copy there, Works fine. No
problem there.
If Folder B exists, kill all files there before copying. But it does
not enter the Kill statement
behaving like Folder B does not exist, and I do not see anything wrong
with path name spelling.
..
Sub copySheet2()
On Error Resume Next
Dim SheetName As String
SheetName = "Cost Summary"
Dim Source As String ‘ Source Folder
Dim Rng1 As Range Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Source = "P:\Cost Reports\08 - October"
Dim Dest As String ‘ Destination Folder
Dim DestPath As String
Dim Message As String
Dim Title As String
Dim Default As String
Dim MyValue As String
Dim defAnswer As String
DestPath = "P:\Cost Reports\"
defAnswer = "08 - December"
Message = "Enter Destination Workbook"
Title = "Destination Workbook"
MyValue = InputBox(Message, Title, defAnswer)
If MyValue <> Empty Then
Dest = DestPath + MyValue
End If
If fs.FileExists(Dest) = False Then 'If Dest folder does not
exist, create it.
MkDir Dest
Else ‘ If it Exists, Delete All existing files in Destination
Folder
‘ Never been able to enter here to execute this statement
‘I cannot see anything wrong with name spelling
Kill "Dest\*.*"
End If
Dim FoundFile As String
FoundFile = Dir(Source + "\*.xls")
Do While FoundFile <> ""
Workbooks.Open Source + "\" + FoundFile, 0
Selection.Copy
Workbooks(FoundFile).Sheets(SheetName).Copy
Set Rng1 = Worksheets("Cost Summary").Range("C4:N25")
Rng1.Copy
Rng1.PasteSpecial xlPasteValues
Workbooks(FoundFile).Close savechanges:=True
' If the file exists in Dest folder, Overwrite the file.
‘ This if fs.FileExists should be redundant if above Kill
works
If fs.FileExists(Dest + "\" + FoundFile) = False Then
ActiveWorkbook.SaveAs Dest + "\" + FoundFile
ActiveWorkbook.Close savechanges:=False
End If
FoundFile = Dir()
Loop
'I want to have all open WB's closed at this point.
'but my previous statements are not achieving that
End Sub
Thank you for your help,
J.P.
Folder A to Folder B.
..
If Folder B does not exists, create it and copy there, Works fine. No
problem there.
If Folder B exists, kill all files there before copying. But it does
not enter the Kill statement
behaving like Folder B does not exist, and I do not see anything wrong
with path name spelling.
..
Sub copySheet2()
On Error Resume Next
Dim SheetName As String
SheetName = "Cost Summary"
Dim Source As String ‘ Source Folder
Dim Rng1 As Range Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Source = "P:\Cost Reports\08 - October"
Dim Dest As String ‘ Destination Folder
Dim DestPath As String
Dim Message As String
Dim Title As String
Dim Default As String
Dim MyValue As String
Dim defAnswer As String
DestPath = "P:\Cost Reports\"
defAnswer = "08 - December"
Message = "Enter Destination Workbook"
Title = "Destination Workbook"
MyValue = InputBox(Message, Title, defAnswer)
If MyValue <> Empty Then
Dest = DestPath + MyValue
End If
If fs.FileExists(Dest) = False Then 'If Dest folder does not
exist, create it.
MkDir Dest
Else ‘ If it Exists, Delete All existing files in Destination
Folder
‘ Never been able to enter here to execute this statement
‘I cannot see anything wrong with name spelling
Kill "Dest\*.*"
End If
Dim FoundFile As String
FoundFile = Dir(Source + "\*.xls")
Do While FoundFile <> ""
Workbooks.Open Source + "\" + FoundFile, 0
Selection.Copy
Workbooks(FoundFile).Sheets(SheetName).Copy
Set Rng1 = Worksheets("Cost Summary").Range("C4:N25")
Rng1.Copy
Rng1.PasteSpecial xlPasteValues
Workbooks(FoundFile).Close savechanges:=True
' If the file exists in Dest folder, Overwrite the file.
‘ This if fs.FileExists should be redundant if above Kill
works
If fs.FileExists(Dest + "\" + FoundFile) = False Then
ActiveWorkbook.SaveAs Dest + "\" + FoundFile
ActiveWorkbook.Close savechanges:=False
End If
FoundFile = Dir()
Loop
'I want to have all open WB's closed at this point.
'but my previous statements are not achieving that
End Sub
Thank you for your help,
J.P.