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


Board Regular
Dec 11, 2007
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 = ""
  If MyFolderPath <> "" Then
    MsgBox "De volgende folder wordt verwerkt: " & MyFolderPath & "  ====>  cel : " & strMyRange
  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
    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")
  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
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

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
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:rolleyes: but does in Excel2003
Upvote 0
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... :(
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back