Create New Folder

[JMay]

My below code is bombing on the next to last line "Thisworkbook.SaveAs..."
Can anyone spot my problem?, please.
TIA


Sub Writingfilenames()
Dim foldername As String
Dim Filename As String
foldername = Sheets("ADSS-01").Name
If Not FolderExists(foldername) Then MkDir foldername
Filename = Sheets("ADSS-01").Cells(3, 4)
ThisWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\" &
Filename & ".xls"
End Sub

'-----------------------------------------------------------------
Function FolderExists(Folder) As Boolean
'-----------------------------------------------------------------
Dim sFolder As String
On Error Resume Next
sFolder = Dir(Folder, vbDirectory)
If sFolder <> "" Then
If (GetAttr(sFolder) And vbDirectory) = vbDirectory Then
FolderExists = True
End If
End If
End Function

 

[Jim Rech]

At the time the macro breaks does the folder C:\My Documents\ADSS-01" exist?
It seems to me that a possible flaw is that you're assuming that C:\My
Documents is the active folder when the macro is run.

--
Jim Rech
Excel MVP
|
| My below code is bombing on the next to last line "Thisworkbook.SaveAs..."
| Can anyone spot my problem?, please.
| TIA
|
|
| Sub Writingfilenames()
| Dim foldername As String
| Dim Filename As String
| foldername = Sheets("ADSS-01").Name
| If Not FolderExists(foldername) Then MkDir foldername
| Filename = Sheets("ADSS-01").Cells(3, 4)
| ThisWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\" &
| Filename & ".xls"
| End Sub
|
| '-----------------------------------------------------------------
| Function FolderExists(Folder) As Boolean
| '-----------------------------------------------------------------
| Dim sFolder As String
| On Error Resume Next
| sFolder = Dir(Folder, vbDirectory)
| If sFolder <> "" Then
| If (GetAttr(sFolder) And vbDirectory) = vbDirectory Then
| FolderExists = True
| End If
| End If
| End Function
|
|

 

[Tom Ogilvy]

Your code doesn't appear to do anything to check for the folder as a sub
folder of "C:\My Documents\" nor to create a folder in that location.

Sub Writingfilenames()
Dim Filename As String
On Error Resume Net
Mkdir "C:\My Documents\" & Sheets("ADSS-01").Name
On Error goto 0
Filename = Sheets("ADSS-01").Cells(3, 4).Value
ThisWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\" &
Filename & ".xls"
End Sub

Isn't the result of Sheets("ADSS-01").Name just "ADSS-01"

 

[JMay]

Thanks Jim
No, "C:\My Documents\ADSS-01" does not exist.

 

[JMay]

Isn't the result of Sheets("ADSS-01").Name just "ADSS-01"
Yes,

 

[JMay]

Replace with your modified code below (noting that you are not using
function call)...
but anyway I'm still getting run-time error 1004 on line
ThisWorkbook.SaveAs Filename:="C:\My Documents\" & foldername & "\" &
Filename & ".xls"
Thoughts?
TIA

 

[Tom Ogilvy]

Sub Writingfilenames()
Dim Filename As String
Dim FolderName As String
On Error Resume Next
FolderName = "C:\My Documents\ADSS-01"
MkDir FolderName
On Error GoTo 0
Filename = Sheets("ADSS-01").Cells(3, 4).Value
ThisWorkbook.SaveAs Filename:=FolderName & _
Filename & ".xls"
End Sub

Worked fine for me.