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
Re: working with multiple directories with VBA in excel
Go back and edit your first post. Put the code into:
Code:
' CODE TAGS, please
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.
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 ]
Re: working with multiple directories with VBA in excel
Thanks I appreciate your help, its in a code window now
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()
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.
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
Re: working with multiple directories with VBA in excel
Quote:
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.
1 Attachment(s)
Re: working with multiple directories with VBA in excel
Excuse me for jumping in... :blush:
Quote:
Originally Posted by
firoz.raj
what is the uses of # sign.Kindly clarify.
It is the button to insert code tags in the advanced post editor:
Re: working with multiple directories with VBA in excel
i did not get Advanced Option.Kindly let me know please.
Re: working with multiple directories with VBA in excel
Quote:
Originally Posted by
firoz.raj
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.
2 Attachment(s)
Re: working with multiple directories with VBA in excel
Quote:
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.
how should i set the advanced Editor as my default ???.i have tried using Quick Reply.But i did not get .Kindly find the attachment also.
Re: working with multiple directories with VBA in excel
Quote:
Originally Posted by
firoz.raj
how should i set the advanced Editor as my default ???.
The default editor setting is in your User CP under "Settings & Options > Edit Options". You will find it way down in the "Miscellaneous Options" window. The correct setting to get the advanced editor is called "Enhanced Interface" there, though.
As about the screen shot of what you get presented as the advanced editor, I've reached the limits of my knowledge now. For me it has always been working just fine, using IE8 on XP pro SP3. You may want to start a new thread about that topic in the Feedback section. I will follow it with interest. (And it's getting a bit off-topic here now... ;))
Re: working with multiple directories with VBA in excel
