ChDrive netzwerklaufwerke auslesen

Public Function ASCIItoANSI(ByVal Text As String) As String
Call OemToCharA(Text, Text)
ASCIItoANSI = Text
End Function
Sub pdf_auflisten()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
pfad = .SelectedItems(1)
If Right(pfad, 1)  "\" Then pfad = pfad & "\"
Else
pfad = ""
End If
End With
If pfad = "" Then MsgBox ("Kein Ordner gewählt!"): Exit Sub Else MsgBox pfad
'------------ Ordner und Unterordner durchsuchen nach z.B PDF Und .xlsm
ActiveSheet.Columns("A:B").ClearContents
Dim objShell As Object, objExec As Object
Dim vntRet As Variant, strTMP As String
Dim Ws2 As Worksheet
Set Ws2 = Tabelle2
Set objShell = CreateObject("WScript.Shell")
ChDrive Left(pfad, 1)
ChDir pfad
Set objExec = objShell.Exec("cmd /c dir /s /b *.pdf *.xlsm")
strTMP = ASCIItoANSI(objExec.StdOut.ReadAll)
vntRet = Split(strTMP, vbCrLf)
'------------ Ordner und Unterordner durchsuchen nach z.B PDF
If UBound(vntRet) > 0 Then
zeile = 2
Ws2.Range("A2").Resize(UBound(vntRet), 1) = Application.Transpose(vntRet)
For Z = 1 To UBound(vntRet)
With Ws2
.Hyperlinks.Add Anchor:=.Range("A" & zeile), Address:=.Range("A" & zeile), ScreenTip:=.Range( _
_
"A" & zeile).Value, TextToDisplay:=.Range("A" & zeile).Value
End With
Ws2.Cells(zeile, 2) = Mid(Ws2.Cells(zeile, 1), InStrRev(Ws2.Cells(zeile, 1), "\") + 1)
zeile = zeile + 1
Next
End If
Set objShell = Nothing
End Sub