Check if folder exists, if yes just copy sheet in to folder?
 

Hi all, I have the code below that copies all visible WorkSheets to a
new folder and renames the sheets, however i am struggling with the
fact that if the folder exists the code stops and shows a Path error,
how can i modify the code to check if folder exists, if it does just
copy the worksheet with the DateString in to that folder?

All help greatly appreciated!
Regards,
Simon

Sub Copy_All_Visible_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String
Ash = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False

DateString = Format(Now, "dd-mm-yyyy")
Set WbMain = ThisWorkbook

FolderName = WbMain.Path & "\" & Left(Ash, Len(Ash) - 0)
MkDir FolderName

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName _
& "\" & Wb.Sheets(1).Name & " " & DateString &
".xls"
Wb.Close False
End If
Next sh

MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Simon Lloyd
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708
View this thread: http://www.excelforum.com/showthread...hreadid=553148

Check if folder exists, if yes just copy sheet in to folder?
 

You can use Dir to check for the existence of a folder:


Function FolderExists(strPath As String) As Boolean
FolderExists = (Dir(strPath, vbDirectory) < "")
End Function

Andrew


Simon Lloyd wrote:
Hi all, I have the code below that copies all visible WorkSheets to a
new folder and renames the sheets, however i am struggling with the
fact that if the folder exists the code stops and shows a Path error,
how can i modify the code to check if folder exists, if it does just
copy the worksheet with the DateString in to that folder?

All help greatly appreciated!
Regards,
Simon

Sub Copy_All_Visible_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String
Ash = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False

DateString = Format(Now, "dd-mm-yyyy")
Set WbMain = ThisWorkbook

FolderName = WbMain.Path & "\" & Left(Ash, Len(Ash) - 0)
MkDir FolderName

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName _
& "\" & Wb.Sheets(1).Name & " " & DateString &
".xls"
Wb.Close False
End If
Next sh

MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Simon Lloyd
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708
View this thread: http://www.excelforum.com/showthread...hreadid=553148

Check if folder exists, if yes just copy sheet in to folder?
 

Hi Simon,

One way, replace:

MkDir FolderName

with

On Error Resume Next
MkDir FolderName
On Error Goto 0


---
Regards,
Norman



"Simon Lloyd"
wrote in message
...

Hi all, I have the code below that copies all visible WorkSheets to a
new folder and renames the sheets, however i am struggling with the
fact that if the folder exists the code stops and shows a Path error,
how can i modify the code to check if folder exists, if it does just
copy the worksheet with the DateString in to that folder?

All help greatly appreciated!
Regards,
Simon

Sub Copy_All_Visible_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String
Ash = ActiveSheet.Name
Application.ScreenUpdating = False
Application.EnableEvents = False

DateString = Format(Now, "dd-mm-yyyy")
Set WbMain = ThisWorkbook

FolderName = WbMain.Path & "\" & Left(Ash, Len(Ash) - 0)
MkDir FolderName

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName _
& "\" & Wb.Sheets(1).Name & " " & DateString &
".xls"
Wb.Close False
End If
Next sh

MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Simon Lloyd
------------------------------------------------------------------------
Simon Lloyd's Profile:
http://www.excelforum.com/member.php...fo&userid=6708
View this thread: http://www.excelforum.com/showthread...hreadid=553148

Check if folder exists, if yes just copy sheet in to folder?
 

Thanks Norman, worked a treat, i was just having trouble if someon
clicked the button to save the sheets twice i had all sorts of errors
i have added a time satmp as well as a date stamp so it won't throw a
error up if the file already exists in the folder!

Andrew thansks for your response too, it just wasn't quite what
needed to incorporate without writing a few more lines of code....i'
usless at it and it takes me ages with trial and error!

Regards,
Simo

--
Simon Lloy
-----------------------------------------------------------------------
Simon Lloyd's Profile: http://www.excelforum.com/member.php...nfo&userid=670
View this thread: http://www.excelforum.com/showthread.php?threadid=55314