Please HELP!!!

[no27fiorano]

Hi please *help me* with the problem.

I have a around 300 workbooks each workbook contains employee
information. The workbooks are named as the employee code, starting
from 10512(e.g. 10512.xls, 10513.xls etc). I want to copy information
from various cells (ranges like first_name, second_name, etc) from each
workbook into one master sheet (master.xls) and I want to do it without
opening each sheet. Before copying I also want to concatenate some of
the information.

Can someone please tell me how to write a code for doing this and save
a ton of my time in the process?

Thanks.

 

[Bob Phillips]

Here is some code

Sub ExcelData()
Const BaseFolder As String = "C:\People"
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim oConn As Object
Dim oRS As Object
Dim iRow As Long
Dim sConnect As String
Dim sSQL As String

Set oFSO = CreateObject("Scripting.FileSystemobject")
Set oFolder = oFSO.getfolder(BaseFolder)
For Each oFile In oFolder.Files
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & oFile.Path & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"""

sSQL = "SELECT * FROM [Sheet1$A1:B1]"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

' Check to make sure we received data.
If Not oRS.EOF Then
iRow = iRow + 1
Range("A" & iRow).Value = oRS.fields(0).Value
Range("B" & iRow).Value = oRS.fields(1).Value
Else
MsgBox "No records returned.", vbCritical
End If

' Clean up our Recordset object.
oRS.Close
Next oFile

Set oRS = Nothing


End Sub

--
HTH

Bob Phillips

"no27fiorano" <[email protected]>
wrote in message
news:[email protected]...