Imports System.IO Imports Microsoft.Office.Interop Public Class ClassDragDrop Public Shared files_dropped As String() Public Shared Function Drop_File(e As DragEventArgs) Try ClassLogger.Add(">> Drop_File", False) files_dropped = Nothing If e.Data.GetDataPresent(DataFormats.FileDrop) Then Dim MyFiles() As String Dim i As Integer ' Assign the files to an array. MyFiles = e.Data.GetData(DataFormats.FileDrop) ' Loop through the array and add the files to the list. For i = 0 To MyFiles.Length - 1 ClassLogger.Add(">> Simple FileDrop - File: " & MyFiles(i), False) ReDim Preserve files_dropped(i) files_dropped(i) = "@DROPFROMFSYSTEM@" & MyFiles(i) ' ListBox1.Items.Add(MyFiles(i)) Next Return files_dropped ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then Dim oApp Try oApp = New Outlook.Application() Catch ex As Exception MsgBox("Fehler bei Initialisieren von Outlook-API:" & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Evtl ist Outlook nicht in der dafür vorgesehenen For") End Try ClassLogger.Add(">> Drop of msg", False) 'supports a drop of a Outlook message Dim myobj As Object For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count myobj = oApp.ActiveExplorer.Selection.Item(i) Dim subj As String = myobj.Subject If subj.Contains("\") Then subj = subj.Replace("\", "-") End If If subj.Contains("/") Then subj = subj.Replace("/", "-") End If 'hardcode a destination path for testing Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (subj + ".msg").Replace(":", "")) ClassLogger.Add(">> Drop of msg - File:" & strFile, False) myobj.SaveAs(strFile) ReDim Preserve files_dropped(i) files_dropped(i) = "@OUTLOOK_MESSAGE@" & strFile Next Return files_dropped 'Drop eines Outlook Attachments ElseIf (e.Data.GetDataPresent("aryFileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then '// the first step here is to get the stbFileName '// of the attachment and '// build a full-path name so we can store it '// in the temporary folder '// '// set up to obtain the aryFileGroupDescriptor '// and extract the file name Dim stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream) Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512] stmInput.Read(aryFileGroupDescriptor, 0, 512) '// used to build the stbFileName from the aryFileGroupDescriptor block Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("") '// this trick gets the stbFileName of the passed attached file Dim intCnt As Integer = 76 Do While aryFileGroupDescriptor(intCnt) <> 0 stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE"))) intCnt += 1 Loop stmInput.Close() Dim anhaenge = e.Data.GetDataPresent("FileContents") 'Dim path As String = "C:\VBProjekte\Dateien" '// put the zip file into the temp directory Dim strOutFile As String = Path.GetTempPath() & stbFileName.ToString() '// create the full-path name '// '// Second step: we have the file name. '// Now we need to get the actual raw '// data for the attached file and copy it to disk so we work on it. '// '// get the actual raw file into memory Dim msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email If msInput Is Nothing = False Then '// allocate enough bytes to hold the raw date Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte '// set starting position at first byte and read in the raw data msInput.Position = 0 msInput.Read(aryFileBytes, 0, CType(msInput.Length, Int32)) '// create a file and save the raw zip file to it Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) '; fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length) fsOutput.Close() ' // close the file Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile) '// always good to make sure we actually created the file If (finTemp.Exists = True) Then ReDim Preserve files_dropped(0) files_dropped(0) = "@OUTLOOK_ATTACHMENT@" & strOutFile If LogErrorsOnly = False Then ClassLogger.Add(">> Drop an Attachment - File: " & strOutFile, False) Return files_dropped Else ClassLogger.Add(">> Attachment File from Outlook could not be created", False) End If End If End If Catch ex As Exception MsgBox("Error in Drop-File" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Function ''' ''' Diese Funktion entfernt alle Zeichen aus dem übergebenen String ''' die in Dateinamen nicht erlaubt sind. ''' ''' Der zu prüfende String ''' String ohne nichterlaubte Zeichen Private Shared Function AdjustPath(Input As String) As String Return System.Text.RegularExpressions.Regex.Replace(Input, "[\\/:*?""<>|]", String.Empty) End Function End Class