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

[Simon Lloyd]

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

[Andrew Taylor]

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

[Norman Jones]

Hi Simon,

One way, replace:

> MkDir FolderName

with

On Error Resume Next
MkDir FolderName
On Error Goto 0


---
Regards,
Norman



"Simon Lloyd" <[email protected]>
wrote in message
news:[email protected]...
>
> 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
>

[Simon Lloyd]

Thanks Norman, worked a treat, i was just having trouble if someone 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 an error up if the file already exists in the folder!

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

Regards,
Simon