Test macro Excel2007 (totalize over all files in a folder)

[evert]

I'm trying to write a macro for Excel2007 and I only have a lower version.
Could anybody test if the following macro "Samentellen_facturen" works fine with Excel2007?

What the macro is supposed to do is:
- let the user select a folder
- let the user choose a cell by entering like "D9"
- read all excel files present in the folder
- add up the number in the cell chosen by the user, from each excel file found in the folder

Thanks in advance!

Option Explicit
Dim MyFolderPath As String
Dim FactuurFile() As String
Dim FactuurFileCount As Long
Dim TotalAmount As Double
Dim strMyRange As String


Public Sub Samentellen_facturen()
  MsgBox "Begin samentellen facturen"
  
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  TotalAmount = 0
  
  MyFolderPath = ""
  Select_directory
  
  If MyFolderPath <> "" Then
    Select_SourceCellRange
    MsgBox "De volgende folder wordt verwerkt: " & MyFolderPath & "  ====>  cel : " & strMyRange
    GetFacturen_2007
    ReadFacturen
  End If
  
  ThisWorkbook.Sheets(1).Cells(10, 2) = TotalAmount
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  
  MsgBox "Einde samentellen facturen"
End Sub
Private Sub Select_directory()
'Select directory
  
  Dim lngCount As Long
    
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Selecteer eerst de gewenste folder met facturen :"
    .AllowMultiSelect = False
    .Show
    For lngCount = 1 To .SelectedItems.Count
      MyFolderPath = .SelectedItems(lngCount)
    Next lngCount
  End With

End Sub

Private Sub Select_SourceCellRange()
  Dim MyMessage As String
  MyMessage = "Voer de cel in, waar in de facturen het bedrag staat dat U wilt optellen; bijvoorbeeld : "
  MyMessage = MyMessage + Chr(34) & "D9" & Chr(34)
  
  strMyRange = ""
  
  While strMyRange = ""
    strMyRange = InputBox(MyMessage, "Cel selectie")
  Wend
  
  strMyRange = UCase(Trim(strMyRange))
End Sub

Private Sub GetFacturen_2007()
Dim objFSO As Object
Dim fol As Object
Dim fil As Object
Dim i As Long

'wegens excel 2007 geen filesearch meer gebruikt:

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set fol = objFSO.GetFolder(MyFolderPath)

        i = 0

        FactuurFileCount = fol.Files.Count
        ReDim FactuurFile(1 To FactuurFileCount)

        For Each fil In fol.Files
           i = i + 1
           FactuurFile(i) = fil.Path 'Blijkt pad + naam te bevatten
        Next
End Sub


Private Sub ReadFacturen()
  Dim fi As Long
  Dim w As Object
  For fi = 1 To FactuurFileCount
    If FactuurFile(fi) <> ThisWorkbook.Path & "\" & ThisWorkbook.Name And _
                 Right(FactuurFile(fi), 4) = ".xls" Then
      Workbooks.Open Filename:=FactuurFile(fi)
      For Each w In Workbooks
        If w.Path & "\" & w.Name = FactuurFile(fi) Then
          If IsNumeric(w.Sheets(1).Range(strMyRange).Cells(1, 1)) Then
            TotalAmount = TotalAmount + w.Sheets(1).Range(strMyRange).Cells(1, 1)
          End If
          w.Close SaveChanges:=False
        End If
      Next w
    End If
  Next fi
End Sub

 

[evert]

Actually the background of my question is this:
I ran into the same error.
I'm almost sure now that I've used the kind of code that does exist in Excel2007.
I just hope somebody could do the final check - if this macro runs without giving an error like 445.

Funny thing is:
Application.FileDialog(msoFileDialogFolderPicker) doesn't compile in Excel2000 but does in Excel2003

 

[xenou]

I've been avoiding the FileDialog on rumors that it won't be supported after 2003...I've seen at least one post that seems to confirm it (not working in 2007). I guess I'd try to re-write that piece -- can't test here at work to be sure...