Public
Declare
PtrSafe
Function
SetCurrentDirectoryA
Lib
"kernel32"
(
ByVal
lpPathName
As
String
)
As
Long
Sub
Sortieren_Makro_Starten()
SetCurrentDirectoryA ThisWorkbook.Path
Datei = Application.GetOpenFilename(
".PDF,*.PDF"
, MultiSelect:=
True
)
Application.ScreenUpdating =
False
FreieSpalte = Cells(3, 10000).
End
(xlToLeft).Column + 1
Cells(3, FreieSpalte).
Select
For
i = 1
To
UBound(Datei)
888
ActiveWorkbook.FollowHyperlink Datei(i)
Name = InStrRev(Datei(i), "\")
Dateiname = Right(Datei(i), Len(Datei(i)) - Name)
Application.Wait Time + TimeSerial(0, 0, 1)
Application.SendKeys
"^a"
,
True
Application.SendKeys
"^c"
,
True
Dim
objWMI
As
Object
, objProcessList
As
Object
, objProcess
As
Object
Set
objWMI = GetObject(
"winmgmts:{impersonationLevel=impersonate}!\\"
&
".\root\cimv2"
)
Set
objProcessList = objWMI.ExecQuery(
"Select * from Win32_Process "
&
"Where Name = 'AcroRD32.exe'"
)
For
Each
objProcess
In
objProcessList
objProcess.Terminate (0)
GoTo
777
Next
777
If
ActiveCell =
""
Then
ActiveSheet.Paste
ActiveCell.Offset(-1, 0) = Dateiname
Else
Do
ActiveCell.Offset(0, 1).
Select
Loop
Until
ActiveCell =
""
ActiveSheet.Paste
ActiveCell.Offset(-1, 0) = Dateiname
End
If
Dateiname = Empty
FreieSpalte = Empty
Name = Empty
Application.CutCopyMode =
False
Application.ScreenUpdating =
True
Next
i
End
Sub