Laufzeitfehler 2147188160 (80048240)

Sub exportExc2PP()
'############################################################################################### _
'version:                           1.0
'author:                            Patrick Tepass
'date:                              11/17/2014
'changes that needs to be done:     - User Interaction for folder path
'                                   - create manual: How to use this program
'                                   - close all excel and PP
'############################################################################################### _
'INPUT PARAMETER
'folder with Excel Sheets from database
Dim pathExcFold As String
pathExcFold = "H:\ExcExports"
'folder with PowerPoint Template in .pptx
Dim pathPP As String
pathPP = "H:\Export"
'############################################################################################### _
'variables
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String
Dim i As Integer
i = 0
'create full path of PowerPoint Template
pathPP = pathPP & "\" & "Presentation_Template.pptx"
'Count files in folder
Dim fso As Object
Dim numb As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
numb = fso.GetFolder(pathExcFold).Files.Count
Set fso = Nothing
Dim T() As String
ReDim Preserve T(1 To numb)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim j As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("H:\VA_VE\Projects\All_VM_Europe\Database\Export\ExcExports")
j = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file path
'    Cells(i + 1, 2) = objFile.Path
T(j) = objFile.Path
j = j + 1
Next objFile
'open TRW template and set to active presentation
Dim pptApp As PowerPoint.Application
Dim pptSlide As PowerPoint.Slide
Dim pptPresentation As PowerPoint.Presentation
Set pptApp = Nothing
Set pptApp = CreateObject("PowerPoint.Application")
With pptApp
.Visible = True
.WindowState = ppWindowMaximized
.Activate
If pathPP  "" Then
.Presentations.Open Filename:=pathPP, ReadOnly:=msoFalse
Else
.Presentations.Add
End If
Set pptPresentation = .ActivePresentation
End With
'start loop 2   #############################################
Dim k As Integer
Dim newFilename As String
For k = 1 To numb
Workbooks.Open T(k)
Range("B5:F39").Select
Selection.Copy
'create new slides, paste content and determine size & postition
Set pptSlide = pptPresentation.Slides.AddSlide(pptPresentation.Slides.Count + 1,  _
pptPresentation.SlideMaster.CustomLayouts(2))
pptSlide.Select
pptPresentation.Application.ActiveWindow.View.PasteSpecial DataType:= _
ppPasteOLEObject
With pptPresentation.Application.ActiveWindow.Selection.ShapeRange
.Left = 25
.Top = 80
.Width = 1000
.Height = 420
End With
'set title
Dim titleStr As String
titleStr = Range("B1").Value
pptSlide.Shapes(3).TextFrame.TextRange.Text = titleStr
'clear clipboard and close workbook
Application.CutCopyMode = False
ActiveWorkbook.Close False
Next k
'end loop 2     #############################################
End Sub