Collecting data from excel file

Hi Kees, thanks for your query. Stick three Excel spreadsheets into C:\test and make sure cell D10 in each has a month in it. Then try running the following:

--------------------------------------------

Sub GetMyData()

Dim wbOpen As Workbook
Const strPath As String = "C:\test\" '<------- change accordingly
Dim strExtension As String
Dim myValue As String
Dim intTargetrowcount As Integer

intTargetrowcount = 1

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ChDir strPath
'Change extension
strExtension = Dir(strPath & "*.xls")

'Dir returns the first file name that matches pathname.
'To get any additional file names that match pathname, call Dir again with no arguments.
'When no more file names match, Dir returns a zero-length string ("").
'Once a zero-length string is returned, you must specify pathname in subsequent calls or an error occurs.
'You can change to a new pathname without retrieving all of the file names that match the current pathname.
'However, you can't call the Dir function recursively.
'Calling Dir with the vbDirectory attribute does not continually return subdirectories.

Do While strExtension <> ""
Set wbOpen = Workbooks.Open(strPath & strExtension)

'MsgBox wbOpen.Sheets("mydata").Cells(10, 4).Value

'*************************************************************
'alter the following code to tailor to your forms:

'dump the value from the returned form into a variable
'do this (with multiple variables) for multiple form results if necessary
myValue = wbOpen.Sheets("MyData").Range("d10").Value

'close down the form
wbOpen.Close SaveChanges:=False

'add the collected value to your results sheet:
Sheets("Results").Cells(intTargetrowcount, 1).Value = myValue

'and don't forget to create a new row for each returned form
intTargetrowcount = intTargetrowcount + 1

'*************************************************************

strExtension = Dir 'go to the next file in the folder
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

--------------------------------------------

Hope this helps,

Anthony