verschiedene Dateien öffnen
11.02.2019 08:29:02
Tim
ich habe ein Makro welches mir einen Pfad nach Dateien durchsucht. Inhalt in den Ordner können .msg oder auch .PDF Dateien sein. Da laut google für das öffnen der jeweiligen Datei unterschiedliche Befehle angewandt werden müssen, stehe ich vor der Herausforderung das zuvor abzufragen oder eleganter zu lösen.
Mein aktueller Code funktioniert soweit, dass ich einer der beiden Dateiformate öffnen kann, jedoch unterscheidet er nicht selbst wenn .msg dann mach so, wenn due .PDF dann mach so...
Wer kann mir dabei helfen?
Private Sub Commandbutton1_click()
ListBox1.Clear
Dim Suchbegriff As String
Suchbegriff = TextBox1.Value
Dim File
For Each File In FindFiles("C:\Test\" & Suchbegriff)
ListBox1.AddItem File
Next
End Sub
Function FindFiles(ByVal Path As String, Optional ByVal Filter As String = "*", Optional ByVal Internal As Boolean) As Collection
Dim File As Object, Folder As Object, SubFolder As Object
Static FS As Object, Files As Collection
If Files Is Nothing Or Not Internal Then Set Files = New Collection
If FS Is Nothing Then Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder(Path)
For Each File In Folder.Files
If File.Name Like Filter Then Files.Add File.Path
Next
For Each SubFolder In Folder.SubFolders
FindFiles SubFolder.Path, Filter, True
Next
Set FindFiles = Files
End Function
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long, strDatei As String, loLetzte As Long
Application.ScreenUpdating = False
With UserForm1.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
strDatei = .List(i, 0)
End If
Next i
End With
ActiveWorkbook.FollowHyperlink strDatei 'für PDF Datei
'für .msg datein
Dim objApp As Object 'Outlook.Application
Dim objItem As Object 'Outlook.MailItem
Set objApp = CreateObject("Outlook.Application")
Set objItem = objApp.Session.OpenSharedItem(strDatei)
objItem.Display
Set objApp = Nothing
Set objItem = Nothing
Application.WindowState = xlMinimized
End Sub