try this
select the folder in which files are saved
Function SelectFolder(Optional Title As String, Optional TopFolder _
As String) As String
Dim objShell As New Shell32.Shell
Dim objFolder As Shell32.Folder
Set objFolder = objShell.BrowseForFolder _
(0, Title, 1, TopFolder)
If Not objFolder Is Nothing Then
SelectFolder = objFolder.Items.Item.Path
End If
End Function
Sub merge_sheets_from_workbooks_to_single()
' tool -> reference -> Microsoft shell control and automation
'On Error GoTo gggg
Dim fldpth As String
Dim fld, fil As Object
Dim ask As Workbook
fldpth = SelectFolder("Select Folder", "")
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpth)
For Each fil In fld.Files
Set ask = Workbooks.Open(fil.Path)
If ask.Sheets("Path").Range("b2").Value <> ask.FullName Then
MsgBox "Path does not exists -------> " & ask.Name
End If
ask.Close
Next fil
End Sub
On Sat, Jul 2, 2011 at 4:39 AM, Nasim <nbeiz...@gmail.com> wrote:
> Hi,
>
> I am using excel 2010. I have searched internet and have come up with
> below codes to:
>
> 1- Open a folder
> 2- Loop through excel files and open them one by one.
> 3- Check existence of path in opened file (path is in the sheet called
> "Path", cell B2 of opened file)
> 4- Give me a message if path does not exist.
> 5- Go to next file in folder and repeat above
>
> The problem is that when I check the existence of path, it changes the
> DIR so my loop is only opening the 1st file in strPath and then it
> changes to 2ns DIR
>
> I tried to change the path back to strPath but when it loops it always
> opens the first file (which it already checked in 1st round of loops).
> Here is my code:
>
>
> strPath = BrowseFolder(Caption:="Select the folder with list of
> employees.") ' I have a function to get path to where my files are
> strExtension = Dir(strPath & "\" & "*.xls*")
>
>
> Do While Len(strExtension) <> 0 'checking if folder exists
> Set wbOpen = Workbooks.Open(strPath & "\" & strExtension)
>
> 'To check if folder in B2 exists:
> If Len(Dir(wbOpen.Sheets("path").Range("B2").Value, vbDirectory)) = 0
> Then ' This changes the Dir
> MsgBox "Below folder does not exist! Please correct the path
> on template (or create folder) and re-run the program." & vbNewLine &
> wbOpen.Sheets("path").Range("B2").Value
> Exit Sub
> End If
> With wbOpen
> .Close SaveChanges:=False
> End With
> k = Len(Dir(strPath)) ' Just to change the Dir to strPath- it does
> change the path to strPath but starts from 1st file again and again
> and again
> strExtension = Dir
> Loop
>
> I searched a lot but could not find anything that I understand. Your
> help is greatly appreciated.
> Thanks,
>
> Nasim
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Follow us on TWITTER for tips tricks and links :
> http://twitter.com/exceldailytip
> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
> To post to this group, send email to excel-macros@googlegroups.com
>
> <><><><><><><><><><><><><><><><><><><><><><>
> Like our page on facebook , Just follow below link
> http://www.facebook.com/discussexcel
>
--
*Regards*
* *
*Ashish Koul*
*akoul*.*blogspot*.com <http://akoul.blogspot.com/>
http://akoul.posterous.com/
*akoul*.wordpress.com <http://akoul.wordpress.com/>
My Linkedin Profile <http://in.linkedin.com/pub/ashish-koul/10/400/830>
P Before printing, think about the environment.
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
