Add worksheet

[gibbo1715]

I dont think this is as simple as it sounds

Ok, I have a master workbook containing a number of worksheets.

What I need to be able to do is as follows

1. Use vba to search a directory that contains a number of sub folders

2. Each subfolder contains an excel workbook with one spreadsheet, this has the same name as the sub folder, I need to select this.

3. I then need to import that worksheet into my workbook and delete the original

Any ideas on any of the above would be most welcome

Cheers

Gibbo

Ok i think i ve made a start along the right lines, how can i select the right file from here then

Option Compare Text
Option Explicit
 
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Type BrowseInfo
    hOwner                  As Long
    pidlRoot                As Long
    pszDisplayName          As String
    lpszINSTRUCTIONS        As String
    ulFlags                 As Long
    lpfn                    As Long
    lParam                  As Long
    iImage                  As Long
End Type
Type SHFILEOPSTRUCT
    hwnd                    As Long
    wFunc                   As Long
    pFrom                   As String
    pTo                     As String
    fFlags                  As Integer
    fAnyOperationsAborted   As Boolean
    hNameMappings           As Long
    lpszProgressTitle       As String
End Type
Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long
 
Function BrowseFolder(Optional Caption As String = "") As String
Dim BrowseInfo      As BrowseInfo
    Dim FolderName      As String
    Dim ID              As Long
    Dim Res             As Long
    With BrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = Caption
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfn = 0
    End With
    FolderName = String$(MAX_PATH, vbNullChar)
    ID = SHBrowseForFolderA(BrowseInfo)
    If ID Then
        Res = SHGetPathFromIDListA(ID, FolderName)
        If Res Then
            BrowseFolder = Left$(FolderName, InStr(FolderName, _
            vbNullChar) - 1)
        End If
    End If
End Function
 
Sub Import()
Dim Search          As String
    Dim Prompt          As String
    Dim Title           As String
    Dim FPath()         As String
    Dim FName()         As String
    Dim Path            As String
    Dim FileName        As String
    Dim WS              As Worksheet
Path = BrowseFolder("Select A Folder")
    If Path = "" Then
        Prompt = "You didn't select a folder. The procedure has been canceled."
        Title = "Procedure Canceled"
        MsgBox Prompt, vbCritical, Title
        Exit Sub
    End If
End Sub

[Killian]

I had a workbook that does a similar thibg so I've adapted it.
You'll need to check the code (the constant for the path, for example) and I haven't done anything about deleting the old worksheet/file

[gibbo1715]

Thanks i ll have a look when i finish work as i cant open zip files here

I managed to figure it out, heres the code i ended up with for those with a similar problem

Gibbo

Option Explicit
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, "X:\1715")
'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
'Destroy the Shell Application
    Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = ""
        If Not Left(BrowseForFolder, 1) = "" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
Exit Function
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Sub Import()
Dim Search          As String
    Dim Prompt          As String
    Dim Title           As String
    Dim FPath()         As String
    Dim FName()         As String
    Dim Path            As String
    Dim FileName        As String
    Dim CurWorkbook     As String
CurWorkbook = ThisWorkbook.Name
Path = BrowseForFolder("Select A Folder")
    If Path = "" Then
        Prompt = "You didn't select a folder. The procedure has been canceled."
        Title = "Procedure Canceled"
        MsgBox Prompt, vbCritical, Title
        Exit Sub
    End If
    FileName = dir(Path, vbDirectory)
    Workbooks.Open FileName:=Path & "" & FileName & ".xls"
Sheets(FileName).Copy _
    After:=Workbooks(CurWorkbook).Sheets("Chart")
    Workbooks(FileName).Activate
    Application.DisplayAlerts = False
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
    Workbooks(CurWorkbook).Activate
End Sub