Opening each file in a folder using msoFileDialogFolderPicker

  • Thread starter Thread starter Ayo
  • Start date Start date
A

Ayo

How do I use this code to loop through all the files in a folder and perform
some action on each

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the location of the RFDS folder"
.Show
For Each vrtSelectedItem In .SelectedItems
myFile= vrtSelectedItem
If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
MsgBox myFile
End If
Next vrtSelectedItem
End With

What I am am trying to do is, select a folder and transfer all the
information on each file in that folder to a worksheet. The code above gets
me to the folder but I need to figure out how to now tell the code to open
each file in that folder so that I can perform the neccessary action on the
file, close the file and then open the next file in the folder.
Thanks.
 
Option Compare Text
'Opens each .xls file in the folder and moves the active sheet
'to the workbook containing the code.
'Jim Cone - San Francisco - September 2006
Sub FilesToWorksheets_R3()
On Error GoTo ThatHurt
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim blnTask As Boolean

If Val(Application.Version) >= 10 Then
blnTask = Application.ShowWindowsInTaskbar
Application.ShowWindowsInTaskbar = False
End If
Application.ScreenUpdating = False
'Specify the folder...
strPath = "C:\Program Files\Lavasoft\Ad-aware 6\Logs"

'Use Microsoft Scripting runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

'Check type of file in the folder and open file.
For Each objFile In objFolder.Files
If objFile.Name Like "*.xls" Then
strName = objFile.Name
Application.StatusBar = strName
Workbooks.Open objFile
ActiveSheet.Name = Left$(strName, 30)
ActiveSheet.Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Workbooks(strName).Close savechanges:=False
End If
Next 'objFile
CloseOut:
On Error Resume Next
Application.ShowWindowsInTaskbar = blnTask
Application.StatusBar = False
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Exit Sub

ThatHurt:
Beep
MsgBox "Error " & Err.Number & " " & Err.Description, , "Text File Creation"
GoTo CloseOut
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)




"Ayo"
wrote in message
How do I use this code to loop through all the files in a folder and perform
some action on each

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the location of the RFDS folder"
.Show
For Each vrtSelectedItem In .SelectedItems
myFile= vrtSelectedItem
If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
MsgBox myFile
End If
Next vrtSelectedItem
End With

What I am am trying to do is, select a folder and transfer all the
information on each file in that folder to a worksheet. The code above gets
me to the folder but I need to figure out how to now tell the code to open
each file in that folder so that I can perform the neccessary action on the
file, close the file and then open the next file in the folder.
Thanks.
 
Option Compare Text
'Opens each .xls file in the folder and moves the active sheet
'to the workbook containing the code.
'Jim Cone - San Francisco - September 2006
Sub FilesToWorksheets_R3()
On Error GoTo ThatHurt
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim blnTask As Boolean

If Val(Application.Version) >= 10 Then
blnTask = Application.ShowWindowsInTaskbar
Application.ShowWindowsInTaskbar = False
End If
Application.ScreenUpdating = False
'Specify the folder...
strPath = "C:\Program Files\Lavasoft\Ad-aware 6\Logs"

'Use Microsoft Scripting runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

'Check type of file in the folder and open file.
For Each objFile In objFolder.Files
If objFile.Name Like "*.xls" Then
strName = objFile.Name
Application.StatusBar = strName
Workbooks.Open objFile
ActiveSheet.Name = Left$(strName, 30)
ActiveSheet.Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Workbooks(strName).Close savechanges:=False
End If
Next 'objFile
CloseOut:
On Error Resume Next
Application.ShowWindowsInTaskbar = blnTask
Application.StatusBar = False
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Exit Sub

ThatHurt:
Beep
MsgBox "Error " & Err.Number & " " & Err.Description, , "Text File Creation"
GoTo CloseOut
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)




"Ayo"
wrote in message
How do I use this code to loop through all the files in a folder and perform
some action on each

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the location of the RFDS folder"
.Show
For Each vrtSelectedItem In .SelectedItems
myFile= vrtSelectedItem
If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
MsgBox myFile
End If
Next vrtSelectedItem
End With

What I am am trying to do is, select a folder and transfer all the
information on each file in that folder to a worksheet. The code above gets
me to the folder but I need to figure out how to now tell the code to open
each file in that folder so that I can perform the neccessary action on the
file, close the file and then open the next file in the folder.
Thanks.
Click to expand...

Your code helps me so much. Thanks!
 
Back
Top