I am currently using Outlook 2010 and I am currently able to manually search a folder in outlook by using the "More" button and adding attachments:yes and attachment contains: where I input the filename to find an email and get the timestamp from when it was sent. I have thousands of attachments for which I need to do this and I would like to automate the process but I am an outlook vba noobie and I do not know the command to perform the search by attachment name, I have tried googling this but to no avail any help would be greatly appreciated thanks!
You can use Restrict https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
Example here: http://www.jpsoftwaretech.com/save-all-attachments-from-selected-folder/
Set newItems = itms.Restrict("[Attachment] > 0")
Combined with:
attName = MsgAttach.Item(attachmentNumber)
If InStr(attName, "search string here") Then
Debug.Print "- " & attName
End If
Outlook Object Model will not let you search for an item with a particular attachment file name. You can explicitly loop through all items in the folder and check the attachment filename, but that will be highly inefficient.
On the Extended MAPI level (C++ or Delphi) you can create a subrestriction on the attachments. If using Redemption is an option (I am its author), it allows to specify Attachments in RDOItems.Find/Restrict:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set vFolder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID)
set vItems = vFolder.Items
set vMsg = vItems.Find("Attachments LIKE '%.zip%' ")
while not (vMsg Is Nothing)
MsgBox vMsg.Subject
set vMsg = vItems.FindNext
wend
Related
Our office runs Arobat DC Pro and Excel 2016, we have been using the code below (scaled down version) in Excel VBA for years to save active Adobe PDF documents (that is, the open PDF doc that most recently had focus).
Since recently upgrading Arobat DC Pro to a newer version, the Acrobat PDDoc.Save method no longer works. It does not throw an error, it just doesn't save the active PDF.
I have had our IT dept. do an uninstall/reinstall of Acrobat PRO on a couple of computers but code still does not work.
Note, the Adobe Acrobat reference library is selected in VBA.
Any suggestions on how to fix?
Sub SaveActivePDF()
Dim AcroApp As Acrobat.CAcroApp
Dim PdDoc As Acrobat.CAcroPDDoc
Dim avdoc As Acrobat.CAcroAVDoc
Dim boolWasSaved As Boolean
Set AcroApp = CreateObject("AcroExch.App")
Set avdoc = AcroApp.GetActiveDoc
Set PdDoc = avdoc.GetPDDoc
DayTime = Format(Now, "yymmddhmmss")
Username = Environ("USERNAME")
PdfNewPath = "C:\Users\" & Username & "\Desktop\TEST PDF " & DayTime & ".pdf"
boolWasSaved = PDDoc.Save(PDSaveFull, PdfNewPath) '<-- NOT WORKING
If boolWasSaved = True Then
MsgBox "PDF WAS SAVED!"
Else: MsgBox "ERROR - PDF not saved"
End If
End Sub
For the record, access to the Acrobat library was blocked by sofware updates that changed default settings.
The issue was resolved as follows: Open any PDF > Edit > Preferences > Security (Enhanced) > ** UNCHECK ** check box "Enable Protected Mode at startup (Preview)" > exit all PDFs.
VBA idle->press "F2"-> search "AcroPDDoc"->locate its method "Save"
Function Save(nType As Integer, sFullPath As String) As Boolean
In Adobe's acrobatsdk_iacguide.pdf, description of Parameter nType is a little bit confusing. Not sure what integer is for PDSaveFull
nType is a logical OR of one or more of the following flags: PDSaveIncremental — Write changes only, not the complete file. This
will always result in a larger file, even if objects have been
deleted.
PDSaveFull — Write the entire file to the filename specified by
szFullPath.
PDSaveCopy — Write a copy of the file into the file specified by
szFullPath, but keep using the old file. This flag can only be
specified if PDSaveFull is also used.
PDSaveCollectGarbage — Remove unreferenced objects; this often reduces
the file size, and its usage is encouraged. This flag can only be
specified if PDSaveFull is also used.
PDSaveLinearized — Save the file optimized for the web, providing hint
tables. This allows the PDF file to be byte-served. This flag can only
be specified if PDSaveFull is also used.
Been using this code for a while to upload a file to SharePoint and noticed the other day that when the file is uploaded, it is checked out to myself automatically and have to go into SharePoint and manually check-in so that others can view the file. Any way to modify or add to my code below to auto check-in a file after it uploads? Totally stumped and any help would be greatly appreciated.
Sub SharePointUpload()
Dim WSN
Dim spAdd
Set WSN = CreateObject("WScript.Network")
spAdd = "https://mysharepoint/test"
WSN.mapnetworkdrive "N:", spAdd
ActiveWorkbook.Save
Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object
' Where you will enter Sharepoint location path
SharepointAddress = "\\mysharepoint\test"
' Where you will enter the local file path
LocalAddress = "C:\data\sample_file.xlsm"
Set objNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists(LocalAddress) Then
FS.CopyFile LocalAddress, SharepointAddress
Else: MsgBox "File does not exist!"
End If
Set objNet = Nothing
Set FS = Nothing
WSN.removenetworkdrive "N:"
End Sub
I had the same issue with our SharePoint Document library even with option Require Check Out switched off - some documents (Word, Excel) were uploaded as Checked Out automatically (green arrow mark) whereas others were in fact Checked In from upload. Moreover when I wanted to Check In manually such documents, I got error message about missing mandatory field, although there was no field in the library set as mandatory.
The reason in my case was the field Title. This field is presented in library as default text field and it is also presented in Office files. I noticed that for Office files with empty field Title the document is automatically Checked Out during upload. When uploaded document contained some text in Title property, no Check Out was set. I also tried to use workflow to change the Title and then Check Out file (after creation), but it was not working - initial Check In was required to start the workflow. Manual change of document properties works but that's too tedious...
The first programmatic option to handle this issue could be to fill Title property of uploaded document when empty (i.e. add file name or any other text). Should work well with many languages. Example with Python:
from docx import Document
path = 'D:/myfile.docx'
document = Document(path)
document_property = document.core_properties
if not document_property.title:
document_property.title = 'Everything is Awesome'
document.save(path)
In VBA Title should accessible via Wb.BuiltinDocumentProperties("Title").
Another successful option for me was to find column Title in Columns of Document library and rename it to something else (I used Titlex as new name), then try to upload new document with empty Title - this time there was no automatic Check Out for the uploaded document. Then I could set the Titlex back to Title without returning the issue.
This has been bugging me for while as I feel I have few pieces of the puzzle but I cant put them all together
So my goal is to be able to search all .pdfs in a given location for a keyword or phrase within the content of the files, not the filename, and then use the results of the search to populate an excel spreadsheet.
Before we start, I know that this easy to do using the Acrobat Pro API, but my company are not going to pay for licences for everyone so that this one macro will work.
The windows file explorer search accepts advanced query syntax and will search inside the contents of files assuming that the correct ifilters are enabled. E.g. if you have a word document called doc1.docx and the text inside the document reads "blahblahblah", and you search for "blah" doc1.docx will appear as the result.
As far as I know, this cannot be acheived using the FileSystemObject, but if someone could confirm either way that would be really useful?
I have a simple code that opens an explorer window and searches for a string within the contents of all files in the given location. Once the search has completed I have an explorer window with all the files required listed. How do I take this list and populate an excel with the filenames of these files?
dim eSearch As String
eSearch = "explorer " & Chr$(34) & "search-ms://query=System.Generic.String:" & [search term here] & "&crumb=location:" & [Directory Here] & Chr$(34)
Call Shell (eSearch)
Assuming the location is indexed you can access the catalog directly with ADO (add a reference to Microsoft ActiveX Data Objects 2.x):
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows'"
sql = "SELECT System.ItemNameDisplay, System.ItemPathDisplay FROM SystemIndex WHERE SCOPE='file:C:\look\here' AND System.Kind <> 'folder' AND CONTAINS(System.FileName, '""*.PDF""') AND CONTAINS ('""find this text""')"
rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then
Do While Not rs.EOF
Debug.Print "File: "; rs.Collect(0)
Debug.Print "Path: "; rs.Collect(1)
rs.MoveNext
Loop
End If
Try using the next function, please:
Function GetFilteredFiles(foldPath As String) As Collection
'If using a reference to `Microsoft Internet Controls (ShDocVW.dll)_____________________
'uncomment the next 2 lines and comment the following three (without any reference part)
'Dim ExpWin As SHDocVw.ShellWindows, CurrWin As SHDocVw.InternetExplorer
'Set ExpWin = New SHDocVw.ShellWindows
'_______________________________________________________________________________________
'Without any reference:_____________________________________
Dim ExpWin As Object, CurrWin As Object, objshell As Object
Set objshell = CreateObject("Shell.Application")
Set ExpWin = objshell.Windows
'___________________________________________________________
Dim Result As New Collection, oFolderItems As Object, i As Long
Dim CurrSelFile As String
For Each CurrWin In ExpWin
If Not CurrWin.Document Is Nothing Then
If Not CurrWin.Document.FocusedItem Is Nothing Then
If left(CurrWin.Document.FocusedItem.Path, _
InStrRev(CurrWin.Document.FocusedItem.Path, "\")) = foldPath Then
Set oFolderItems = CurrWin.Document.folder.Items
For i = 0 To oFolderItems.count
On Error Resume Next
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Else
Result.Add oFolderItems.item(CLng(i)).Name
On Error GoTo 0
End If
Next
End If
End If
End If
Next CurrWin
Set GetFilteredFiles = Result
End Function
Like it is, the function works without any reference...
The above function must be called after you executed the search query in your existing code. It can be called in the next (testing) way:
Sub testGetFilteredFiles()
Dim C As Collection, El As Variant
Set C = GetFilteredFiles("C:\Teste VBA Excel\")'use here the folder path you used for searching
For Each El In C
Debug.Print El
Next
End Sub
The above solution iterates between all IExplorer windows and return what is visible there (after filtering) for the folder you initially used to search.
You can manually test it, searching for something in a specific folder and then call the function with that specific folder path as argument ("\" backslash at the end...).
I've forgotten everything I ever knew about VBA, but recently stumbled across an easy way to execute Explorer searches using the Shell.Application COM object. My code is PowerShell, but the COM objects & methods are what's critical. Surely someone here can translate.
This has what I think are several advantages:
The query text is identical to what you wouold type in the Search Bar in Explorer, e.g.'Ext:pdf Content:compressor'
It's easily launched from code and results are easily extracted with code, but SearchResults window is available for visual inspection/review.
With looping & pauses, you can execute a series of searches in the same window.
I think this ability has been sitting there forever, but the MS documentation of the Document object & FilterView method make no mention of how they apply to File Explorer.
I hope others find this useful.
$FolderToSearch = 'c:\Path\To\Folder'
$SearchBoxText = 'ext:pdf Content:compressor'
$Shell = New-Object -ComObject shell.application
### Get handles of currenlty open Explorer Windows
$CurrentWindows = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ).HWND
$WinCount = $Shell.Windows().Count
$Shell.Open( $FolderToSearch )
Do { Sleep -m 50 } Until ( $Shell.Windows().Count -gt $WinCount )
$WindowToSerch = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ) | Where { $_.HWND -notIn $CurrentWindows }
$WindowToSearch.Document.FilterView( $SearchBoxText )
Do { Sleep -m 50 } Until ( $WindowToSearch.ReadyState -eq 4 )
### Fully-qualified name:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Path
### or just the filename:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Name
### $FoundFIles is an array of strings containing the names.
### The Excel portion I leave to you! :D
I want to edit a pdf file attached as an object to my Excel doc with VBA.
Background: Since I don't want to share both files in a .zip or else and there is no network drive everybody has granted access to, I need a "foolproof" solution.
The pdf file contains a form (mandatory) and will be filled with information from this Excel doc. As mentioned, I already had a solution with the pdf file stored on a network drive.
Dim file, new_name As String
Set AcroApp = CreateObject("AcroExch.App")
Set AvDoc = CreateObject("AcroExch.AVDoc")
'Open new PDF file
'Use local path
file = "C:\Users\992\Desktop\example.pdf"
new_name = "New_PDF_12092019"
If AvDoc.Open(Datei, Name) Then
AcroApp.Show
Set PDDoc = AvDoc.GetPDDoc()
Set jso = PDDoc.GetJSObject
'Get cart ID
jso.getField("Feld1").Value = CStr(ActiveSheet.Range("B12").Value)
'Get Project ID
jso.getField("Feld2").Value = CStr(ActiveSheet.Range("B14").Value)
...
My question is: is there any possibility to use an embedded object with AcroExch.AVDoc?
Since parameter szFullPath requires the full path of the file to open, I thought about getting the "path" of the object and use it - but I cannot figure out how. Already tried this: https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff
Maybe someone can help me with this.
Thanks in advance!
I'm trying to programatically generate an email in my Lotus Notes 7 client, with the contents being a chunk of RTF code that I build specifically for each email to be sent, in excel.
I'm able to build, populate and send the email. But the body comes across as the ascii text of my RTF code, rather than the formatted version I was expecting.
I have a feeling it's because my emailer function (inherited from a previous developer) is passing it as plain text. How can I get it passed as Rich text?
The relevant emailer code: (mail box name is company specific, so has been changed)
Also, please note that I want the RichText as the body, not an attachment.
Public Sub SendNotesMail(sSubject, sTo, sCC, sBCC, sAttachment, sMessage, Optional sSaveSent As Boolean = True)
'Set up the objects required for Automation into lotus notes
Dim Maildb 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc 'The mail document itself
Dim RichTextitem As Object 'The RichText Item
Dim AttachME 'The sAttachment richtextfile object
Dim Session 'The notes session
Dim EmbedObj 'The embedded object (sAttachment)
Dim rAttach() As String
Dim x As Integer
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
Session.ConvertMime = False
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
UserName = Session.UserName
MailDbName = "XXXXX.nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", "XXXXXX.nsf")
' Is Mail file already open?
If Maildb.IsOpen = False Then
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.form = "Memo"
MailDoc.sendto = sTo
MailDoc.CopyTo = sCC
MailDoc.BlindCopyTo = sBCC
MailDoc.Subject = sSubject
Set RichTextitem = MailDoc.Createrichtextitem("Body")
Call RichTextitem.appendtext(sMessage)
MailDoc.SaveMessageOnSend = sSaveSent
'Set up the embedded object and Attachment and attach it
If sAttachment <> "" Then
ParseWords rAttach(), sAttachment, ";"
For x = 0 To UBound(rAttach) Step 1
Set AttachME = MailDoc.Createrichtextitem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", rAttach(x), "Attachment")
Next x
End If
'Send the document
MailDoc.SaveMessageOnSend = True
MailDoc.SEND 0, sTo
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
Here is a chunk of my RTF text. It doesn't render anything, this is just to show the text format I mean.
{\rtf1\adeflang1025\ansi\ansicpg1252\uc1\adeff31507\deff0\stshfdbch31505\stshfloch31506\stshfhich31506\stshfbi31507\deflang1033\deflangfe1033\themelang1033\themelangfe0\themelangcs0{\fonttbl{\f0\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fbidi \fswiss\fcharset0\fprq2{\*\panose 020b0604020202020204}Arial;}
{\f34\fbidi \froman\fcharset1\fprq2{\*\panose 02040503050406030204}Cambria Math;} {\flomajor\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}
{\fdbmajor\f31501\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\fhimajor\f31502\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria;}
{\fbimajor\f31503\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\flominor\f31504\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}
{\fdbminor\f31505\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\fhiminor\f31506\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0502020204030204}Calibri;}
{\fbiminor\f31507\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f39\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\f40\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}
{\f42\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\f43\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\f44\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f45\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}
{\f46\fbidi \froman\fcharset186\fprq2 Times New Roman Baltic;}{\f47\fbidi \froman\fcharset163\fprq2 Times New Roman (Vietnamese);}{\f49\fbidi \fswiss\fcharset238\fprq2 Arial CE;}{\f50\fbidi \fswiss\fcharset204\fprq2 Arial Cyr;}
{\f52\fbidi \fswiss\fcharset161\fprq2 Arial Greek;}{\f53\fbidi \fswiss\fcharset162\fprq2 Arial Tur;}{\f54\fbidi \fswiss\fcharset177\fprq2 Arial (Hebrew);}{\f55\fbidi \fswiss\fcharset178\fprq2 Arial (Arabic);}
Your RTF formatted text won't work with Lotus Notes's Rich Text format. They are separate things.
You can create Rich Text using the Notes API. See the methods that start with NotesRichTextXXXX. It's not simple, mind you, and there's no easy way to convert the RTF to Notes Rich Text unfortunately.
There is an add-on that will help you deal with Rich Text. I haven't tried it but it has always been highly recommended: http://www.geniisoft.com/showcase.nsf/MidasLSX
Using the MIME classes you can send an HTML email via Notes, and that may be your best bet.
You will need to actually use native Lotus Notes methods for a richtext field and create the richtext content from the "RichtextItem" object you have created. The sMessage field will need to be plain text, and if you will then need to specify the formatting via the NotesRichTextStyle object.
API details for R7 found here and here. When writing "styled" richtext you need to do it inline, that is, you start appending text, then before you want to make it bold, get a notesRichTextStyle object set the properties on it, then apply it to the richtext object, then write the text. When you need to change styles again, you repeat this process. This example demonstrates the usage. MIDAS richtext is a tried and true product that takes the hassle out of the process for creating richtext, but you will need to purchase a license.
For the attachment, you can use the "embedObject" method of the RichTextItem to attach a file into the body of the email, as you have already shown in your code sample, but I think you can re-use the richtextitem object for the "body" field, don't use the "attachment" field. You should be able to send the email over the internet and users see the attachment's location in the email and detach it.
Here is the help documentation for embedding objects with examples in case you're weren't already aware of it's functionality. (All the links provided are for R7.)