working with multiple directories with VBA in excel
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 15 of 15

Thread: working with multiple directories with VBA in excel

Hybrid View

  1. #1
    Join Date
    Jun 2010
    Posts
    4

    Exclamation working with multiple directories with VBA in excel

    I have run into a small problem with a current project I am working on. Bassically what the project will do is open multiple files in multiple directories and reformat some files and combine data between the files to create some reports.

    The problem I am having is that when i go to cycle through the the second set of files while cycling through the first set my code seems to "forget" or lose its place within the first directory it is cycling through.

    Here is all the code from my project.. the problem occurs during "filename = dir()"

    Code:
    Option Explicit
     
     '32-bit API declarations
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
    pszpath As String) As Long
     
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
    As Long
     
    Public Type BrowseInfo
        hOwner As Long
        pIDLRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
     
    Function GetDirectory(Optional msg) As String
        On Error Resume Next
        Dim bInfo As BrowseInfo
        Dim path As String
        Dim r As Long, x As Long, pos As Integer
         
         'Root folder = Desktop
        bInfo.pIDLRoot = 0&
         
         'Title in the dialog
        If IsMissing(msg) Then
            bInfo.lpszTitle = "Please select the folder of the excel files to copy."
        Else
            bInfo.lpszTitle = msg
        End If
         
         'Type of directory to return
        bInfo.ulFlags = &H1
         
         'Display the dialog
        x = SHBrowseForFolder(bInfo)
         
         'Parse the result
        path = Space$(512)
        r = SHGetPathFromIDList(ByVal x, ByVal path)
        If r Then
            pos = InStr(path, Chr$(0))
            GetDirectory = Left(path, pos - 1)
        Else
            GetDirectory = ""
        End If
    End Function
     
    Sub CombineFiles()
    
        Dim LastCell        As Range
        Dim Wkb, Wkb2            As Workbook
        Dim WS, WS2              As Worksheet
        Dim ThisWB, d, m, fd, tex, path, pathmd, FileName, FileName2  As String
        Dim md As Integer
        
    If UNameWindows() <> "speelb" Then
    MsgBox "Only run this while Brian S. is logged in"
    Exit Sub
    End If
    Sheet1.Range("A42").Copy
    Sheet1.Range("A41").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ThisWB = ThisWorkbook.Name
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        path = GetDirectory
        pathmd = GetDirectory
        FileName2 = Dir(pathmd & "\*.xls", vbNormal)
        FileName = Dir(path & "\*.xls", vbNormal)
    
        Do Until FileName = ""
            If FileName <> ThisWB Then
                Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
                For Each WS In Wkb.Worksheets
                    Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
                    
    'cover page procedure
                    If WS.Name = "Cover Page" Then
    
                    md = Sheet1.Range("a45").Value
                    If Sheet1.Range("A44") = 1 Then
                    m = "January"
                    ElseIf Sheet1.Range("A44") = 2 Then
                    m = "February"
                    ElseIf Sheet1.Range("A44") = 3 Then
                    m = "March"
                    ElseIf Sheet1.Range("A44") = 4 Then
                    m = "April"
                    ElseIf Sheet1.Range("A44") = 5 Then
                    m = "May"
                    ElseIf Sheet1.Range("A44") = 6 Then
                    m = "June"
                    ElseIf Sheet1.Range("A44") = 7 Then
                    m = "July"
                    ElseIf Sheet1.Range("A44") = 8 Then
                    m = "August"
                    ElseIf Sheet1.Range("A44") = 9 Then
                    m = "September"
                    ElseIf Sheet1.Range("A44") = 10 Then
                    m = "October"
                    ElseIf Sheet1.Range("A44") = 11 Then
                    m = "November"
                    ElseIf Sheet1.Range("A44") = 12 Then
                    m = "December"
                    End If
                    
                    If Sheet1.Range("A43") = 1 Then
                    d = "Sunday"
                    ElseIf Sheet1.Range("A43") = 2 Then
                    d = "Monday"
                    ElseIf Sheet1.Range("A43") = 3 Then
                    d = "Tuesday"
                    ElseIf Sheet1.Range("A43") = 4 Then
                    d = "Wednesday"
                    ElseIf Sheet1.Range("A43") = 5 Then
                    d = "Thursday"
                    ElseIf Sheet1.Range("A43") = 6 Then
                    d = "Friday"
                    ElseIf Sheet1.Range("A43") = 7 Then
                    d = "Saturday"
                    End If
                    
                    fd = d & ", " & m & " " & md
                    
                    tex = Sheet1.Range("A38") & fd & Sheet1.Range("A39")
                    
                    Sheet1.Range("a11") = tex
    
        With Sheet1.Range("a11").Characters(Start:=87, Length:=Len(fd)).Font
            .Name = "Arial"
            .FontStyle = "Bold Italic"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = -16776961
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
                    ThisWorkbook.Sheets("Sheet1").Range("A1:B31").Copy Destination:=WS.Range("A18:B48")
                    WS.Columns("A:B").EntireColumn.AutoFit
                    WS.Rows("18:48").EntireRow.AutoFit
                    WS.Rows(28).RowHeight = 32
                    WS.PageSetup.Zoom = 60
                    WS.Activate
                    ActiveWindow.Zoom = 80
                    End If
                    Dim nam As String
        'add in ommissions, site, providers
                             Do Until FileName2 = ""
    
                             nam = Right(FileName2, Len(FileName2) - 1)
                                If nam = Wkb.Name Then
                                    Set Wkb2 = Workbooks.Open(FileName:=pathmd & "\" & FileName2)
                                    For Each WS2 In Wkb2.Worksheets
    
    
                                        If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
                                        Else
                                            WS2.Copy After:=Wkb.Sheets(Wkb.Sheets.Count)
                                        End If
                                    Next WS2
                                            Wkb2.Close False
                                End If
                                FileName2 = Dir()
                            Loop
        'MD page procedure
                    If WS.Name = "MD" Then
        ' need to change format, delete columns, delete rows, add in formulas, cross check with chksmp and pull in names
                    End If
    '     MsgBox FileName
    
    '                If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
    '                Else
    '                    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    '                End If
                Next WS
                Wkb.Save
                Wkb.Close False
            End If
            MsgBox FileName
            FileName = Dir()
        Loop
        Application.EnableEvents = True
        Application.ScreenUpdating = True
         
        Set Wkb = Nothing
        Set LastCell = Nothing
    End Sub
    
    Function UNameWindows() As String
        UNameWindows = Environ("USERNAME")
    End Function
    
    
    
    Public Function TrailingSlash(strFolder As String) As String
        If Len(strFolder) > 0 Then
            If Right(strFolder, 1) = "\" Then
                TrailingSlash = strFolder
            Else
                TrailingSlash = strFolder & "\"
            End If
        End If
    End Function
    Last edited by bspeel; July 1st, 2010 at 11:56 AM.

  2. #2
    Join Date
    Jan 2006
    Location
    Chicago, IL
    Posts
    14,960

    Re: working with multiple directories with VBA in excel

    Go back and edit your first post. Put the code into:
    Code:
    '  CODE TAGS, please
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

  3. #3
    Join Date
    Jun 2010
    Posts
    4

    Re: working with multiple directories with VBA in excel

    Ok I can edit my posts now but how do i put my code into that code window? sorry im new to this.
    Last edited by bspeel; June 30th, 2010 at 03:02 PM.

  4. #4
    Join Date
    Jan 2006
    Location
    Chicago, IL
    Posts
    14,960

    Re: working with multiple directories with VBA in excel

    You can highlight the code (you need ADVANCED View) and then click the # icon. Or, add [] then [/] with the word CODE before the last ]
    David

    CodeGuru Article: Bound Controls are Evil-VB6
    2013 Samples: MS CODE Samples

    CodeGuru Reviewer
    2006 Dell CSP
    2006, 2007 & 2008 MVP Visual Basic
    If your question has been answered satisfactorily, and it has been helpful, then, please, Rate this Post!

  5. #5
    Join Date
    Jun 2010
    Posts
    4

    Re: working with multiple directories with VBA in excel

    Thanks I appreciate your help, its in a code window now
    Last edited by bspeel; July 1st, 2010 at 11:55 AM.

  6. #6
    DataMiser is offline Super Moderator Power Poster
    Join Date
    Jul 2008
    Location
    WV
    Posts
    4,813

    Re: working with multiple directories with VBA in excel

    A lot of code to look through, not much time so I just skimmed it. The error is pretty clear though. You can not use Dir() in this fashion and expect it to work the way you are trying to get it to.

    When you call Dir() the first time and set the path you override it with the next call. All calls to dir() after that refer to the second instance and not the first.

    Jusrt skimming the code I can not tell what exactly you are trying to do with these 2 different paths but you will need to modify the code if you want to cycle through files in 2 different locations using dir()
    Always use [code][/code] tags when posting code.

  7. #7
    DataMiser is offline Super Moderator Power Poster
    Join Date
    Jul 2008
    Location
    WV
    Posts
    4,813

    Re: working with multiple directories with VBA in excel

    You could perhaps use a filelist box or the filesystem object for one of the directories and the dir function for the other.
    Always use [code][/code] tags when posting code.

  8. #8
    Join Date
    Jun 2010
    Posts
    4

    Re: working with multiple directories with VBA in excel

    Yah i think using dir and filesystem might work. Thats what I figured was happening with the dir() having its path overiden i just wasnt sure if there was a way to set up two instances for dir() but from what i have been reading you cant.

    To elaborate a bit what im bassically doing is i have a folder that contains 4 sub folders. one of the sub folders holds about 20 files that will eventually become final reports. the other three subfolders hold various files with various types of data to include in the final reports.

    what I am trying to do is hold the folder with the main final reports open while cycling through the files in the other 3 subfolders.

    i

  9. #9
    Join Date
    Dec 2008
    Location
    Step Into(F11)
    Posts
    464

    Question Re: working with multiple directories with VBA in excel

    You can highlight the code (you need ADVANCED View) and then click the # icon. Or, add [] then [/] with the word CODE before the last ]
    what is the uses of # sign.Kindly clarify.

  10. #10
    Join Date
    Jun 2010
    Location
    Germany
    Posts
    2,583

    Re: working with multiple directories with VBA in excel

    Excuse me for jumping in...

    Quote Originally Posted by firoz.raj View Post
    what is the uses of # sign.Kindly clarify.
    It is the button to insert code tags in the advanced post editor:
    Attached Images Attached Images  

  11. #11
    Join Date
    Dec 2008
    Location
    Step Into(F11)
    Posts
    464

    Question Re: working with multiple directories with VBA in excel

    i did not get Advanced Option.Kindly let me know please.

  12. #12
    Join Date
    Jun 2010
    Location
    Germany
    Posts
    2,583

    Re: working with multiple directories with VBA in excel

    Quote Originally Posted by firoz.raj View Post
    i did not get Advanced Option.Kindly let me know please.
    I have set the advanced editor as my default, so I think I don't even see all options to get there. But the "Quick Reply" window at the end of the thread view for instance has a "Go Advanced" button that will take you there.

  13. #13
    Join Date
    Jul 2001
    Location
    Sunny South Africa
    Posts
    11,090

    Re: working with multiple directories with VBA in excel

    firoz, read again closely here :

    http://www.codeguru.com/forum/showpo...67&postcount=4

    I'd also suggest you have a proper read here :

    http://www.codeguru.com/forum/faq.php

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Azure Activities Information Page

Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center