Verlinkungen anstatt XLS-Dateien
14.12.2021 12:08:47
berte
habe in der beigefügten Tabelle:
https://www.herber.de/bbs/user/149799.xls
ein Makro (FilesListen), das wunderbar funktioniert.
Jetzt möchte ich allerdings anstatt Excel-Dateien nur deren Verlinkungen verarbeiten und dann klappt das nicht mehr:
Option Explicit
Sub FilesListen()
Dim Zeile As Integer
Dim DateiName As String
Dim zaehler As Boolean
Dim WS As Worksheet
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strDirectory As String
Dim Filter As String
Dim N As Integer
Call EventsOff
strDirectory = "C:\Users\joche.LAPTOP-N7KFVOSR\Desktop\Test_EB\"
Filter = "lnk"
N = Len(Filter)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strDirectory)
Set WS = ActiveWorkbook.Worksheets("Abrechnung")
For Each objFile In objFolder.files
DateiName = Dir(objFile.Path)
If Right(objFile.Path, N) = Filter And DateiName ThisWorkbook.Name Then
If zaehler = False Then
Zeile = 2
Else
Zeile = Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
Workbooks.Open Filename:=objFile.Path
Workbooks(DateiName).Sheets("Abrechnung").Range("A2:F999").Copy
WS.Range("A" & Zeile & ":F" & Zeile).PasteSpecial Paste:=xlValues, operation:=xlNone, skipblanks:=False, Transpose:=False
zaehler = True
Application.CutCopyMode = False
Workbooks(DateiName).Close SaveChanges:=True
End If
Next
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Ich habe keine Ahnung, WO ich WAS ändern muss?
Gruß
berte