I currently have a Windows Forms application that accepts drag and dropped files from other applications. Everything seemed to be working smoothly until we discovered that if we added an email attached to an email, then things got weird.
For example, users had no problem dragging attached jpg or pdf files directly from emails into the application. But when an email (.msg file) was attached to an email, and it was the attached email that was trying to be added to the program, then here's what happens: the following code is able to correctly read the name of the selected attachment that was dragged into the program, but the actual file that is copied is the main containing e-mail (including all the attachments).
Is there any way that I can just pull out the selected/dragged message?
Thanks!!
Here's the entire function:
Public Shared Function HandleFileDrops(ByVal e As System.Windows.Forms.DragEventArgs) As String
' Based on and Borrowed from http://allandynes.com/2015/10/vb-net-drag-and-drop-from-outlook/
Try
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
' We have a file so lets pass it to the calling form
Dim Filename As String() = CType(e.Data.GetData(DataFormats.FileDrop), String())
HandleFileDrops = Filename(0)
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
' We have a embedded file. First lets try to get the file name out of memory
Dim theStream As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
Dim fileGroupDescriptor(512) As Byte
theStream.Read(fileGroupDescriptor, 0, 512)
Dim fileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
Dim i As Integer = 76
While Not (fileGroupDescriptor(i) = 0)
fileName.Append(Convert.ToChar(fileGroupDescriptor(i)))
System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
theStream.Close()
' We should have the file name or if its an email, the subject line. Create our temp file based on the temp path and this info
Dim myTempFile As String = IO.Path.GetTempPath & fileName.ToString
' Look to see if this is a email message. If so save that temporarily and get the temp file.
If InStr(myTempFile, ".msg") > 0 Then
Dim objOL As New Microsoft.Office.Interop.Outlook.Application
Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
If objOL.ActiveExplorer.Selection.Count > 1 Then
MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
End If
For Each objMI In objOL.ActiveExplorer.Selection()
objMI.SaveAs(myTempFile)
Exit For
Next
objOL = Nothing
objMI = Nothing
Else
' If its a attachment we need to pull the file itself out of memory
Dim ms As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream)
Dim FileBytes(CInt(ms.Length)) As Byte
' read the raw data into our variable
ms.Position = 0
ms.Read(FileBytes, 0, CInt(ms.Length))
ms.Close()
' save the raw data into our temp file
Dim fs As IO.FileStream = New IO.FileStream(myTempFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
fs.Write(FileBytes, 0, FileBytes.Length)
fs.Close()
End If
' Make sure we have a actual file and also if we do make sure we erase it when done
If IO.File.Exists(myTempFile) Then
' Assign the file name to the add dialog
HandleFileDrops = myTempFile
Else
HandleFileDrops = String.Empty
End If
Else
Throw New System.Exception("An exception has occurred.")
End If
Catch ex As Exception
MsgBox("Could not copy file from memory. Please save the file to your hard drive first and then retry your drag and drop.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Drag and Drop Failed")
HandleFileDrops = String.Empty
End Try
End Function
This is the section in particular that handles the e-mail:
Dim objOL As New Microsoft.Office.Interop.Outlook.Application
Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
If objOL.ActiveExplorer.Selection.Count > 1 Then
MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
End If
For Each objMI In objOL.ActiveExplorer.Selection()
objMI.SaveAs(myTempFile)
Exit For
Next
objOL = Nothing
objMI = Nothing
After really looking at the code that I borrowed from elsewhere on the web, I now see exactly what it does. The section of code that saves Outlook messages creates a new instance of the current Outlook object and then calls that object to pull in its selected items, which will happen to be the main selected email - not the attached email that was dragged over. I was able to add a couple lines of code to do some comparisons on either the email or attachment name to see what was what.
This now works well for my needs:
Dim objOL As New Microsoft.Office.Interop.Outlook.Application
Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
If objOL.ActiveExplorer.Selection.Count > 1 Then
MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
End If
'If the message itself has the same name as fileName, then just save the selected MailObject
'Otherwise, iterate through all the attachments to the MailObject and save the one that hase that same name as the fileName
For Each objMI In objOL.ActiveExplorer.Selection()
If objMI.Subject = fileName.ToString() Then
objMI.SaveAs(myTempFile)
Else
Dim objAttach As Microsoft.Office.Interop.Outlook.Attachments = objMI.Attachments
For Each attach As Microsoft.Office.Interop.Outlook.Attachment In objAttach
If attach.FileName = fileName.ToString() Then
attach.SaveAsFile(myTempFile)
End If
Next
End If
Exit For
Next
objOL = Nothing
objMI = Nothing
Related
I have a simple vsto addin for word which allows me to select one or more pictures from disk then it inserts them into the current document. It works just fine and I have no problems with it. However, each time it inserts a picture word updates all fields in the document. Once the document has a hundred or so pictures this gets pretty time consuming. I need to turn off the auto updating of fields while these pictures are being inserted, then turn it back on when done.
What I have tried is this:
Adding this line at program start,
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = True
Adding these lines at program end,
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = False
Globals.ThisAddIn.Application.ActiveDocument.Fields.Update()
but word still updates ALL the fields in the document with each picture insertion. Is there some other method to accomplish this?
Thanks
Edit: this is the code that inserts the images
Sub ImportPictures()
Dim strPics As String = String.Empty
Dim arrPics() As String
Dim i As Long
Dim vrtSelectedItem As Object = Nothing
Dim tek As Microsoft.Office.Interop.Word.InlineShape = Nothing
Dim picName As String = String.Empty
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = True
'Open up a file browser so user can choose the spreadsheet for the part
Try
Using OpenFileDialog1 As New OpenFileDialog()
OpenFileDialog1.InitialDirectory = "c:\\"
OpenFileDialog1.Filter = "Images (*.gif;*.jpg;*.jpeg;*.png;*.bmp)|*.gif;*.jpg;*.jpeg;*.png;*.bmp"
OpenFileDialog1.FilterIndex = 1
OpenFileDialog1.RestoreDirectory = True
OpenFileDialog1.Multiselect = True
If OpenFileDialog1.ShowDialog() = DialogResult.OK Then
For Each vrtSelectedItem In OpenFileDialog1.FileNames
strPics = strPics & "|" & vrtSelectedItem
Next vrtSelectedItem
strPics = Mid(strPics, 2)
arrPics = Split(strPics, "|")
System.Array.Sort(arrPics)
For i = 0 To UBound(arrPics)
picName = Right(arrPics(i), Len(arrPics(i)) - InStrRev(arrPics(i), "\"))
tek.LockAspectRatio = True
tek.ScaleHeight = 32.3
tek.Select()
Globals.ThisAddIn.Application.ActiveDocument.Paragraphs.Format.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenter
Globals.ThisAddIn.Application.Selection.InsertCaption(Label:="Figure", Title:=": " & picName, Position:=word.WdCaptionPosition.wdCaptionPositionBelow)
Globals.ThisAddIn.Application.Selection.Collapse(word.WdCollapseDirection.wdCollapseEnd)
Globals.ThisAddIn.Application.Selection.TypeParagraph()
Next i
Else
MsgBox("User pressed Cancel.")
End If
End Using
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = False
Globals.ThisAddIn.Application.ActiveDocument.Fields.Update()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.SystemModal, "Error")
End Try
End Sub
ActiveDocument.Fields.Locked can only affect fields that exist in the document when that code line is executed. Unless you loop through all story ranges, it will also only affect fields in the document body. If you add another field whose property is 'hot' (see https://support.microsoft.com/en-us/topic/which-fields-are-updated-when-you-open-repaginate-or-print-document-e9580e16-7239-5263-83a4-061a27210076), it will update as soon as you insert it. Running ActiveDocument.Fields.Locked again will only prevent further updates.
I'm very new to coding so any help is appreciated.
I've created a simple listbox that displays an array from a text file.
I wanted to add a textbox and a delete button so the user can type a word and then delete that line from the text file.
I've read many forums with various solutions for this but all have returned errors - currently I am getting this error: "System.IO.IOException: 'The process cannot access the file 'C:\Users\hches\source\repos\Inventory\Inventory\bin\Debug\Stock.txt' because it is being used by another process.'"
in sub DeleteLine()
Here is the relevant code to the Delete button and the respective DeleteLine() sub:
Private Sub BTDel_Click(sender As Object, e As EventArgs) Handles BTDel.Click
Dim sr As New StreamReader("Stock.txt")
Dim i As Integer = 0
Dim deleted As Boolean = False
If TBSearch.Text = "" Then
MsgBox("Please enter an Item to Delete.")
Else
Do Until sr.Peek() = -1 Or deleted = True 'prevents it from looping through the whole stock if the item is deleted
Dim Itm As String = sr.ReadLine()
If Itm.Contains(TBSearch.Text) Or Itm.ToLower.Contains(TBSearch.Text.ToLower) Then 'if the line read from the text contains the search word, continue
MsgBox(TBSearch.Text & " has been deleted.") 'simple messagebox says it has been deleted
DeleteLine()
deleted = True
TBSearch.Clear()
ElseIf sr.Peek() = -1 Then 'if it reaches the end of the document and it hasn't been found
MsgBox("Item has not been deleted.") 'message box appears saying it is not deleted
deleted = False
TBSearch.Clear()
End If
i = i + 1
Loop
End If
End Sub
Public Sub DeleteLine()
Dim line As Integer = 0
Dim Filename = "Stock.txt"
Dim TheFileLines As New List(Of String)
For line = 0 To TheFileLines.Count
TheFileLines.AddRange(System.IO.File.ReadAllLines(Filename))
' if line is beyond end of list then exit sub
If line >= TheFileLines.Count Then Exit Sub
TheFileLines.RemoveAt(line)
System.IO.File.WriteAllLines(Filename, TheFileLines.ToArray)
Next
End Sub
Many thanks for any guidance,
Henry
SOLVED -- For anyone interested I will post my solution, thanks for the help.
Public Sub DeleteLine()
ArrayLoad() 'populates my array from text file
File.Delete("Stock.txt") 'deletes original text file
Dim stockList As List(Of String) = ItemNames.ToList 'creates a list using my array
stockList.Remove(TBSearch.Text) 'removes the searched item from the list
File.Create("Stock.txt").Dispose() 'creates a new text file (same name as the original so the program will work fine)
Using sw As New StreamWriter("Stock.txt") 'sets up a streamwriter to write the new list to the text file
For Each item As String In stockList
sw.WriteLine(item)
Next
sw.Flush()
sw.Close()
End Using
End Sub
End Class
Part of my application searches for a string provided by a textbox within .txt files and .pdf files stored on a network drive. It works great on my PC when looking within a directory of a few files stored on a local disk, when I run it on my work PC which is less beefy and looking at a network drive I get "not responding" and it takes a good few minutes to finally wake up again. This is only searching through around 100 files and that number is only going to get bigger.
I thought about adding a progress bar, but if the application is not responding I assume the progress bar will not update? I would be very grateful to hear the advice of someone much more experienced in this than me.
In short, the code searches as described above, uses the name of the folder (that begins with SCC) to add an item to a listbox. If it cannot search the PDF for any reason then it adds it to another listbox displaying the folder names it was unable to search.
Here is the section of code that does the search:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim path As String = ""
Dim list As System.Collections.ObjectModel.ReadOnlyCollection(Of String)
Dim raf As itextsharp.text.pdf.RandomAccessFileOrArray = Nothing
Dim reader As itextsharp.text.pdf.PdfReader = Nothing
Dim searchPhrase As String = faultSearch.Text
VINListBox.Items.Clear()
Region "search plain text"
'finds text within faultSearch textbox within the files in directory
list = My.Computer.FileSystem.FindInFiles(archive_dir, faultSearch.Text, True, FileIO.SearchOption.SearchAllSubDirectories)
For Each foundFile As String In list
path = foundFile
GetVinName(path)
Next
End Region
Region "search PDF"
'Finds text within faultSearch textbox within PDF files in directory
For Each file As String In My.Computer.FileSystem.GetFiles(archive_dir, FileIO.SearchOption.SearchAllSubDirectories)
If System.IO.Path.GetExtension(file).ToUpper = ".PDF" Then
Try
raf = New itextsharp.text.pdf.RandomAccessFileOrArray(file)
reader = New itextsharp.text.pdf.PdfReader(raf, Nothing)
For i As Integer = 1 To reader.NumberOfPages()
Dim pageText As String = itextsharp.text.pdf.parser.PdfTextExtractor.GetTextFromPage(reader, i)
If pageText.ToUpper.Contains(searchPhrase) Then
GetVinName(file)
End If
Next
Catch ex As Exception
GetErrVinName(file)
End Try
End If
Next
End Sub
End Region
Private Sub GetVinName(ByVal strVIN As String)
Dim fldName() As String
fldName = Split(strVIN.ToString, "\",, CompareMethod.Text)
For x = 0 To UBound(fldName) - 1
If InStr(fldName(x), "SCC", CompareMethod.Text) > 0 Then
strVIN = Trim(fldName(x))
If errListBox.Items.Contains(strVIN) = True Then
errListBox.Items.Remove(strVIN)
End If
If VINListBox.Items.Contains(strVIN) = False Then
VINListBox.Items.Add(strVIN)
End If
Exit For
End If
Next
End Sub
Private Sub GetErrVinName(ByVal strVIN As String)
Dim fldName() As String
fldName = Split(strVIN.ToString, "\",, CompareMethod.Text)
For x = 0 To UBound(fldName) - 1
If InStr(fldName(x), "SCC", CompareMethod.Text) > 0 Then
strVIN = Trim(fldName(x))
If VINListBox.Items.Contains(strVIN) = False Then
If errListBox.Items.Contains(strVIN) = False Then
errListBox.Items.Add(strVIN)
Else
Exit Sub
End If
Else
Exit Sub
End If
Exit For
End If
Next
End Sub
I'd like to be able to delete individual files that are stored as attachments in an Access Database through VB.Net
I've managed to get storing, opening and "downloading" from an Access Database to work effectively, but the last piece of the puzzle would be to allow my end-user to delete an individual file in the attachments field.
This seems to be much harder than the other options as I can only seem to find information on how to delete the entire database entry, not just a single attachment. It gets even more complicated if there are more than one attachments stored against the entry.
I am using the following code to check what happens when the datagrid is clicked:
If e.ColumnIndex = ViewFileColum.Index Then
'Get the file name and contents for the selected attachment.
Dim gridRow = childgrid.Rows(e.RowIndex)
Dim tableRow = DirectCast(gridRow.DataBoundItem, DataRowView)
Dim fileName = CStr(tableRow(FILE_NAME_COLUMN_NAME))
Dim fileContents = GetFileContents(DirectCast(tableRow(FILE_DATA_COLUMN_NAME), Byte()))
DisplayTempFile(fileName, fileContents)
End If
If e.ColumnIndex = DownloadFileColumn.Index Then
'Get the file name and contents for the selected attachment.
MoveFile = True
Dim gridRow = childgrid.Rows(e.RowIndex)
Dim tableRow = DirectCast(gridRow.DataBoundItem, DataRowView)
Dim fileName = CStr(tableRow(FILE_NAME_COLUMN_NAME))
Dim fileContents = GetFileContents(DirectCast(tableRow(FILE_DATA_COLUMN_NAME), Byte()))
DisplayTempFile(fileName, fileContents)
End If
I want to add a third section that states if the DeleteFileColumn button is clicked then to remove that particular attachment from the database, but this doesn't seem possible.
When retrieving the information for the above two options, I use the following code:
Dim tempFolderPath = Path.GetTempPath()
Dim tempFilePath = Path.Combine(tempFolderPath, fileName)
'If the specified file exists, add a number to the name to differentiate them.
If File.Exists(tempFilePath) Then
Dim fileNumber = 1
Do
tempFilePath = Path.Combine(tempFolderPath,
String.Format("{0} ({1}){2}",
Path.GetFileNameWithoutExtension(fileName),
fileNumber,
Path.GetExtension(fileName)))
fileNumber += 1
Loop Until Not File.Exists(tempFilePath)
End If
'Save the file and open it.
'If "DOWNLOAD" button is clicked
If MoveFile = True Then
File.WriteAllBytes(SaveLocation & "\" & Path.GetFileNameWithoutExtension(fileName) & Path.GetExtension(fileName), fileContents)
MoveFile = False
'If "OPEN" button is clicked
Else
File.WriteAllBytes(tempFilePath, fileContents)
Dim attachmentProcess = Process.Start(tempFilePath)
If attachmentProcess Is Nothing Then
'Remember the file and try to delete it when this app closes.
tempFilePaths.Add(tempFilePath)
Else
'Remember the file and try to delete it when the associated process exits.
attachmentProcess.EnableRaisingEvents = True
AddHandler attachmentProcess.Exited, AddressOf attachmentProcess_Exited
tempFilePathsByProcess.Add(attachmentProcess, tempFilePath)
End If
End If
This code copies the information before opening it, so I don't ever actually deal with the file in the database directly. I've used adapted this code from another example I found online, but am having a hard time working out how to physically deal with the file on the database, or if its even possible?
Thanks
You need to create an Access DAO Recordset2 object for the attachments field, find the record corresponding to the specific attachment you want to delete, and then Delete() that record.
The following example will remove a document named "testDocument.pdf" from the attachments field for the record where ID=1:
' required COM reference:
' Microsoft Office 14.0 Access Database Engine Object Library
'
' Imports Microsoft.Office.Interop.Access.Dao
'
Dim dbe As New DBEngine
Dim db As Database = dbe.OpenDatabase("C:\Users\Public\Database1.accdb")
Dim rstMain As Recordset = db.OpenRecordset(
"SELECT Attachments FROM AttachTest WHERE ID=1",
RecordsetTypeEnum.dbOpenDynaset)
rstMain.Edit()
Dim rstAttach As Recordset2 = CType(rstMain.Fields("Attachments").Value, Recordset2)
Do Until rstAttach.EOF
If rstAttach.Fields("FileName").Value.Equals("testDocument.pdf") Then
rstAttach.Delete()
Exit Do
End If
rstAttach.MoveNext()
Loop
rstAttach.Close()
rstMain.Update()
rstMain.Close()
db.Close()
I have to open the webCam and take a photo from MS-Access, I was researching, but it has been impossible to do it work.
I would appreciate any help that you give me.
I found this
Private Sub Command11_Click()
Dim tempfile As String
Dim mydevice As WIA.Device
Dim item As WIA.item
Dim imfile As WIA.imagefile
Dim Commondialog1 As WIA.CommonDialog
'put the path and name for the location of your temp file here.
tempfile = ("C:\Users\Desktop\filename.jpg")
'the next 4 lines deletes the old temp file if it exists
Set filesystemobject = CreateObject("Scripting.FileSystemObject")
If filesystemobject.FileExists(tempfile) Then
Kill (tempfile)
End If
'the next two lines set up the configuration
Set Commondialog1 = New CommonDialog
Set mydevice = Commondialog1.ShowSelectDevice
Set item = mydevice.ExecuteCommand(wiaCommandTakePicture) 'instructs the camera to take the picture
Set imfile = item.Transfer 'transfers the picture from the camera
'this line saves the picture to a specified file
imfile.SaveFile (tempfile)
'this sets the picture on the form to show the new picture
Me.OLEUnbound1.Picture = (tempfile)
MsgBox "Picture taken"
Exit_btnTakePicture_click:
Set mydevice = Nothing
Set item = Nothing
Exit Sub
End Sub
this show me enternal cameras, but I need to use the built-in webcam
how is possible get the built-in webCam through MS Access?