VBA - aktuellen Ordner auslesen

Sub SubCombine()
Dim wkbPaste As Workbook
Dim wkbCopy As Workbook
Dim wksSheet As Worksheet
Dim rngRange As Range
Dim strCurrentFile As String
Dim strPath As String
Dim strMacroFile As String
'# Open a new workbook to store the results
Set wkbPaste = Workbooks.Add
Set rngRange = wkbPaste.ActiveSheet.Range("A1")
'# The name of this file (the one with the macro in)
strMacroFile = "Auswertung.xlsm"
'# The directory to be searched
strPath = ActiveWorkbook.Path
'# Retrieve the first file
strCurrentFile = Dir(strPath & "\*.xls")
Do While strCurrentFile  ""
'# Ignore the current directory and the encompassing directory (and the current  _
file)
If strCurrentFile  "." And strCurrentFile  ".." And strCurrentFile   _
strMacroFile Then
'# Open the file
Set wkbCopy = Workbooks.Open(strPath & strCurrentFile)
'# Select and copy the used range
wkbCopy.ActiveSheet.UsedRange.Select
Selection.Copy
'# Paste the data into the other workbook
wkbPaste.Activate
rngRange.Select
ActiveSheet.Paste
'# Move to the next available row
Set rngRange = wkbPaste.ActiveSheet.Range("A" & wkbPaste.ActiveSheet.UsedRange. _
Row + wkbPaste.ActiveSheet.UsedRange.Rows.Count)
'# Close the workbook
wkbCopy.Close False
End If
'# Get the next file
strCurrentFile = Dir
Loop
End Sub