Opening each file in a folder using msoFileDialogFolderPicker

[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.

 

[Jim Cone]

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.

 

[nvntung]

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.

Your code helps me so much. Thanks!