Dir function not looping right?

[pietlinden]

Sorry, I must be having a blonde moment...

I'm looping through a directory and processing all the Excel files in
the directory. What I don't understand is why I'm getting weird errors
when I run the following loop:

Private Sub Command4_Click()
Dim strFolder As String
Dim strFile As String

'--allow user to select folder to process...
strFolder = BrowseFolder("Select a folder")

'--loop through all Excel files in the directory
strFile = Dir(strFolder & "\*.XLS")
Do While Len(strFile) > 0
MsgBox strFile
'---for some reason, this works great exactly twice.
GetFieldNames strFolder & "\" & strFile

strFile = Dir
Loop
End Sub

Public Sub GetFieldNames(ByVal strFile)
' pass in the result of the function that gets the list of files.

On Error GoTo ErrHandler:

Dim appXL As Excel.Application
Dim intCounter As Integer
Dim rs As DAO.Recordset

Set appXL = New Excel.Application
appXL.Workbooks.Open strFile

Set rs = DBEngine(0)(0).OpenRecordset("tblExcelColumns",
dbOpenTable, dbAppendOnly)
For intCounter = 1 To
appXL.ActiveWorkbook.Worksheets(1).Columns.Count
If Not IsEmpty(ActiveWorkbook.Worksheets(1).Cells(1,
intCounter)) Then
'---Change this line to write the column name and the
workbook name to a recordset

rs.AddNew
rs.Fields("FileName") = ActiveWorkbook.Path & "\" &
ActiveWorkbook.Name
rs.Fields("ColumnName") =
ActiveWorkbook.Worksheets(1).Cells(1, intCounter)
rs.Update
Else
Exit For
End If
Next intCounter

MsgBox intCounter & " records hopefully written!"

rs.Close

Set rs = Nothing
appXL.Workbooks.Close

'---I *SHOULD* use something better for this, but right now I'm
worrying about the looping mess...
appXL.Quit
Set appXL = Nothing

Exit Sub

ErrHandler:
rs.Close
Set rs = Nothing
appXL.Workbooks.Close
appXL.Quit
Set appXL = Nothing


End Sub


What's weird is that the loop works great exactly twice. I must be
doing something wrong with DIR. Any clues?

Thanks!

 

[John Nurick]

Hi Dave,

Here is one issue:
appXL.ActiveWorkbook.Worksheets(1).Columns.Count
The Count property in this case will always return 256
I would code it as
xlSheet.Columns.Count

I think I'd go further, e.g.
xlSheet.UsedRange.Columns.Count

 

[pietlinden]

Hi Piet,

Blonde moment? Too blonde to remember to tell us what error(s) you're
getting and what line of code raises them!

Apparently. I think I have it sorted. The UsedRange part was key. As
someone I used to work with doing phone support used to say "Your
description of your problem is like you going to the doctor and when he
asks you where it hurts, you don't answer. Well, I can't help you
then!"

FWIW, here's the code that works... (yeah, I should be using ADO...
I'll get there...)

Public Sub GetFieldNames(ByVal strFile)
' pass in the result of the function that gets the list of files.
'WARNING: Don't use this at home, or in your own code.... BAD things
could happen.

'On Error GoTo ErrHandler:

Dim appXL As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim intCounter As Integer
Dim rs As DAO.Recordset

Set appXL = New Excel.Application
appXL.Workbooks.Open strFile

Set rs = DBEngine(0)(0).OpenRecordset("tblExcelColumns",
dbOpenTable, dbAppendOnly)
'---OOOOkay! worksheet collections are 1-based...
Set xlSheet = appXL.Worksheets(1)

For intCounter = 1 To xlSheet.UsedRange.Columns.Count
'
'---Change this line to write the column name and the
workbook name to a recordset
'MsgBox ActiveWorkbook.Worksheets(1).Cells(1, intCounter) &
vbCrLf & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
rs.AddNew
MsgBox xlSheet.Cells(1, intCounter)
rs.Fields("FileName") = ActiveWorkbook.Path & "\" &
ActiveWorkbook.Name
rs.Fields("ColumnName") = xlSheet.Cells(1, intCounter)
rs.Update

Next intCounter

MsgBox intCounter & " records hopefully written!"

rs.Close
Set rs = Nothing
Set xlSheet = Nothing
appXL.Workbooks.Close
appXL.Quit
Set appXL = Nothing

Exit Sub

ErrHandler:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly
+ vbInformation

rs.Close
Set rs = Nothing
Set xlSheet = Nothing
appXL.Workbooks.Close
appXL.Quit
Set appXL = Nothing


End Sub

 

[John Nurick]

Yes about not being always being able to rely on UsedRange to contain
only the columns of interest. But iterating through UsedRange columns
(a) guarantees - AFAIK - that you'll visit all the columns that may
contain data and (b) avoids unnecessarily iterating through columns that
definitely don't contain data.

But I must be missing something: I got the impression when you said

Here is one issue:
appXL.ActiveWorkbook.Worksheets(1).Columns.Count
The Count property in this case will always return 256
I would code it as
xlSheet.Columns.Count

that you were relying on
xlSheet.Columns.Count
to return something less than 256.

 

[John Nurick]

As you'll have seen from elsewhere in the thread, you can trust
UsedRange to include all the columns that may contain data, but you
can't trust it not to include columns that don't. So if there's a
possibility that someone has being editing the workbook by hand it's
wise to add a test along these lines:

...
For intCounter = 1 To xlSheet.UsedRange.Columns.Count
With ActiveWorkbook.Worksheets(1)
'Make sure there's column header in row 1
If Len(.Cells(1, intCounter).Value) > 0 Then
MsgBox .Cells(1, intCounter).Value & vbCrLf _
& ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
...

End If
End With
Next intCounter