Hi!

Excel 2000.

I'm trying to create a .xlt which contains code that opens and processes all
..xls-files in a certain direktory on the users harddrive.
I need to write VBA looking something like this:


Dim xls as Excel.Workbook

For each xls in "Directory on Harddrive"
Open xls-file
Check for a certain value in xls
Close xls-file
Next


Any ideas on how to write this code?

TIA
PO

Something like this????

Option Explicit
Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim rptWks As Worksheet
Dim testWks As Worksheet
Dim oRow As Long

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
Set rptWks = Workbooks.Add(1).Worksheets(1)
With rptWks
.Range("a1").Resize(1, 2).Value _
= Array("Name", "Found")
End With
oRow = 1
For fCtr = LBound(myFiles) To UBound(myFiles)
oRow = oRow + 1
Set wkbk = Workbooks.Open(myPath & myFiles(fCtr))

Set testWks = Nothing
On Error Resume Next
Set testWks = wkbk.Worksheets("sheet1")
On Error GoTo 0

With rptWks.Cells(oRow, "A")
.Value = myFiles(fCtr)
If testWks Is Nothing Then
.Offset(0, 1).Value = "Missing Sheet"
Else
If testWks.Range("a1").Value = "hi there" Then
.Offset(0, 1).Value = "Yes"
Else
.Offset(0, 1).Value = "No"
End If
End If
End With

wkbk.Close savechanges:=True
Next fCtr
End If

End Sub



PO wrote:

Hi!

Excel 2000.

I'm trying to create a .xlt which contains code that opens and processes all
.xls-files in a certain direktory on the users harddrive.
I need to write VBA looking something like this:

Dim xls as Excel.Workbook

For each xls in "Directory on Harddrive"
Open xls-file
Check for a certain value in xls
Close xls-file
Next

Any ideas on how to write this code?

TIA
PO

--

Dave Peterson

Thanks Dave!

Works just fine.

Regards
PO

"Dave Peterson" wrote in message
...
Something like this????

Option Explicit
Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim rptWks As Worksheet
Dim testWks As Worksheet
Dim oRow As Long

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
Set rptWks = Workbooks.Add(1).Worksheets(1)
With rptWks
.Range("a1").Resize(1, 2).Value _
= Array("Name", "Found")
End With
oRow = 1
For fCtr = LBound(myFiles) To UBound(myFiles)
oRow = oRow + 1
Set wkbk = Workbooks.Open(myPath & myFiles(fCtr))

Set testWks = Nothing
On Error Resume Next
Set testWks = wkbk.Worksheets("sheet1")
On Error GoTo 0

With rptWks.Cells(oRow, "A")
.Value = myFiles(fCtr)
If testWks Is Nothing Then
.Offset(0, 1).Value = "Missing Sheet"
Else
If testWks.Range("a1").Value = "hi there" Then
.Offset(0, 1).Value = "Yes"
Else
.Offset(0, 1).Value = "No"
End If
End If
End With

wkbk.Close savechanges:=True
Next fCtr
End If

End Sub



PO wrote:

Hi!

Excel 2000.

I'm trying to create a .xlt which contains code that opens and processes
all
.xls-files in a certain direktory on the users harddrive.
I need to write VBA looking something like this:

Dim xls as Excel.Workbook

For each xls in "Directory on Harddrive"
Open xls-file
Check for a certain value in xls
Close xls-file
Next

Any ideas on how to write this code?

TIA
PO

--

Dave Peterson