View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
yo yo is offline
external usenet poster
 
Posts: 5
Default quick help: get folder name

sorry to bother you again, can you help me with this?
i run into error (Object required) while trying to do it like below:

Function GetFolderName(bookPath As String) As String
'
' GetFolderName(bookPath) Function Macro
' find workbook folder name - 22/05/2006 18:46
'
Dim i As Integer

Set i = InStrRev(bookPath, "\")
If i 1 Then
' if the path incl. file name(??)
folderName = Right(bookPath, Len(bookPath) - i)
Else
' in case it's in the root folder
i = InStrRev(bookPath, ":")
End If
If iPos 1 Then
' get the folder name
folderName = Right(bookPath, Len(bookPath) - i)
End If

End Function

Sub exportSheetNewBook()
'
' exportSheetNewWorkbook Subroutine Macro
' export each sheet to new workbook - 22/05/2006 18:54
'
' Keyboard Shortcut: Ctrl+Shift+e
'
Dim srcBook As Workbook
Dim newBook As Workbook
Dim fdPath As String
Dim fdName As String
Dim sh As Worksheet
Dim shName As String

Set srcBook = ThisWorkbook
Set sh = srcBook.ActiveSheet
Set fdPath = srcBook.Path ' << this is where it threw the error
Set fdName = GetFolderName(fdPath)

For Each sh In srcBook.Worksheets
sh.Copy

Set newBook = ActiveWorkbook
newBook.SaveAs (fdName & "\" & newBook.ActiveSheet.Name & "_" &
fdName & ".xls")

newBook.Close
Next sh

End Sub