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 Dim oApp As New Outlook.Application Dim sql As String = "DELETE FROM TBPMO_FILES_USER WHERE UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')" ClassDatabase.Execute_non_Query(sql) If e.Data.GetDataPresent(DataFormats.FileDrop) Then If LogErrorsOnly = False Then ClassLogger.Add(">> DataFormats.FileDrop", False) 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 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 If LogErrorsOnly = False Then ClassLogger.Add(">> Drop of OutlookMessage", 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) 'hardcode a destination path for testing Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (myobj.Subject + ".msg").Replace(":", "")) myobj.SaveAs(strFile) ReDim Preserve files_dropped(i) files_dropped(i) = "@OUTLOOKMESSAGE@" & strFile Next Return files_dropped ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then If LogErrorsOnly = False Then ClassLogger.Add(">> FileGroupDescriptor/FileContents", False) '// 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 'MsgBox("Attachment File from Outlook created:" & vbNewLine & strOutFile) ' lblFile.Text += "Attachment File from Outlook created" + Environment.NewLine ReDim Preserve files_dropped(0) files_dropped(0) = "@OUTLOOK_ATTMNT@" & 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) 'lblFile.Text += "Attachment File from Outlook could not be created" + Environment.NewLine End If End If Else 'otherwise, do not handle e.Effect = DragDropEffects.None frmForm_Constructor_OLD.tsstatus_Detail_show(True, "DragEnter ... Other FileFormat") If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... Other FileFormat", False) End If If e.Data.GetDataPresent(DataFormats.FileDrop) Then 'Drop eines Outlook Attachments ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then End If Catch ex As Exception MsgBox("Error in Drop_File: " & ex.Message, MsgBoxStyle.Critical) End Try 'Else ' Dim files() As String = e.Data.GetData(DataFormats.FileDrop) ' Dim filestype() As String ' filestype = e.Data.GetData(DataFormats.CommaSeparatedValue) ' Dim sReader As New StreamReader(filestype(0)) ' 'get the filename from the file without the path ' Dim file_name As String = Path.GetFileName(filestype(0)) ' 'check the extension of the file ' If Path.GetExtension(filestype(0)).ToLower() = ".xml" Then ' 'Read the xml file ' For Each path In files ' 'ReadXMLFile(path) ' Next ' Else ' 'warning about the file type ' MessageBox.Show("Only XML files are supported!", "Warning!", _ 'MessageBoxButtons.OK, _ ' MessageBoxIcon.Warning) ' End If 'End If End Function Public Shared Sub Drag_enter(e As DragEventArgs) Try If e.Data.GetDataPresent(DataFormats.FileDrop) Then e.Effect = DragDropEffects.All If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... SimpleFileDrop", False) frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... SimpleFileDrop") ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then 'handle a message dragged from Outlook e.Effect = DragDropEffects.Copy frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... OutlookMessage") If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... OutlookMessage", False) ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then e.Effect = DragDropEffects.Copy frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... Attachment from Outlook") If LogErrorsOnly = True Then frmForm_Constructor_OLD.tsstatus_Detail_show(True, "DragEnter ... Attachment from Outlook") Else 'otherwise, do not handle e.Effect = DragDropEffects.None frmForm_Constructor_OLD.tslblStatusMain_show(True, "DragEnter ... Other FileFormat") If LogErrorsOnly = True Then ClassLogger.Add("DragEnter ... Other FileFormat", False) End If Catch ex As Exception End Try End Sub End Class