Calling Access function from Excel - excel

I'm trying to call the GUIDFromString Access function from Excel.
Dim accessApp
Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDatabase (ThisWorkbook.Path & "\" & "DB.accdb")
MsgBox accessApp.GUIDFromString("PassingAString")
accessApp.Quit
Set accessApp = Nothing
I've tried different things but all generate an error.
The above is generating:
ActiveX component can't create object
(https://msdn.microsoft.com/en-us/vba/access-vba/articles/application-guidfromstring-method-access)
EDIT: I just came across this post (Password hash function for Excel VBA), using the code from Chris for my purposes.

GUIDFromString only works for actual GUID strings, it seems.
In Access:
? GUIDFromString("some string")
ActiveX component can't create object
? References(1).Guid
{000204EF-0000-0000-C000-000000000046}
? GUIDFromString("{000204EF-0000-0000-C000-000000000046}")
? À ?
It's a byte array, so Debug.Print or MsgBox don't really make sense, but with the GUID string the method works.

Related

Extract file names from a File Explorer search into Excel

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

Change built-in Document properties without opening

I am attempting to run the below line of code in a sub. The purpose of the sub overall is to automatically create agendas for recurring meetings, and notify the relevant people.
'Values for example;
MtgDate = CDate("11/06/2020")
Agenda ="Z:\Business Manual\10000 Management\11000 Management\11000 Communications\Operations Meetings\11335 - OPS CCAR Performance Review Agenda 11.06.20.docx" 'NB it's a string
'and the problematic line:
Word.Application.Documents(Agenda).BuiltinDocumentProperties("Publish Date") = MtgDate
Two questions:
1) Can I assign a document property just like that without opening the document? (bear in mind this vba is running from an excel sheet where the data is stored)
2) Will word.application.documents accept the document name as a string, or does it have to be some other sort of object or something? I don't really understand Word VBA.
Attempts so far have only resulted in
runtime error 427 "remote server machine does not exist or is
unavailable"
or something about a bad file name.
Although Publish Date can be found under Insert > Quick Parts > Document Property it isn't actually a document property. It is a "built-in" CustomXML part, a node of CoverPageProperties, and can be addressed in VBA using the CustomXMLParts collection.
The CustomXML part is only added to the document once the mapped content control is inserted.
Below is the code I use.
As already pointed out for document properties the document must be open.
Public Sub WriteCoverPageProp(ByVal strNodeName As String, ByVal strValue As String, _
Optional ByRef docTarget As Document = Nothing)
'* Nodes: Abstract, CompanyAddress, CompanyEmail, CompanyFax, CompanyPhone, PublishDate
'* NOTE: If writing PublishDate set the content control to store just the date (default is date and time).
'* The date is stored in the xml as YYYY-MM-DD so must be written in this format.
'* The content control setting will determine how the date is displayed.
Dim cxpTarget As CustomXMLPart
Dim cxnTarget As CustomXMLNode
Dim strNamespace As String
If docTarget Is Nothing Then Set docTarget = ActiveDocument
strNodeName = "/ns0:CoverPageProperties[1]/ns0:" & strNodeName
strNamespace = "http://schemas.microsoft.com/office/2006/coverPageProps"
Set cxpTarget = docTarget.CustomXMLParts.SelectByNamespace(strNamespace).item(1)
Set cxnTarget = cxpTarget.SelectSingleNode(strNodeName)
cxnTarget.Text = strValue
Set cxnTarget = Nothing
Set cxpTarget = Nothing
End Sub
You cannot modify a document without opening it. In any event, "Publish Date" is not a Built-in Document Property; if it exists, it's a custom one.
Contrary to what you've been told, not all BuiltinDocumentProperties are read-only; some, like wdPropertyAuthor ("Author"), are read-write.
There are three main ways you could modify a Word document or "traditional" property (which are the ones you can access via .BuiltInDocumentProperties and .CustomProperties):
a. via the Object Model (as you are currently trying to do)
b. for a .docx, either unzipping the .docx, modifying the relevant XML part, and re-zipping the .docx.
c. For "traditional" properties, i.e. the things that you can access via .BuiltInDocumentProperties and .CustomDocumentProperties, in theory you can use a Microsoft .dll called dsofile.dll. But it hasn't been supported for a long time, won't work on Mac Word and the Microsoft download won't work on 64-bit Word. You'd also have to distribute and support it.
But in any case, "Publish Date" is not a traditional built-in property. It's probably, but not necessarily, a newer type of property called a "Cover Page Property". Those properties are in fact pretty much as "built-in" as the traditional properties but cannot be accessed via .BuiltInDocumentProperties.
To modify Cover Page properties, you can either use the object model or method (b) to access the Custom XML Part in which their data is stored. Method (c) is no help there.
Not sure where your error 427 is coming from, but I would guess from what you say that you are trying to see if you can modify the property in a single line, using the fullname of the document in an attempt to get Word to open it. No, you can't do that - you have to use GetObject/CreateObject/New to make a reference to an instance of Word (let's call it "wapp"), then (say)
Dim wdoc As Word.Document ' or As Object
Set wdoc = wapp.Documents.Open("the fullname of the document")
Then you can access its properties, e.g. for the read/write Title property you can do
wdoc.BuiltInDocumentProperties("Title") = "your new title"
wdoc.Save
If Publish Date is the Cover Page Property, once you have a reference to the Word Application and have ensured the document is open you can use code along the following lines:
Sub modPublishDate(theDoc As Word.Document, theDate As String)
' You need to format theDate - by default, Word expects an xsd:dateTime,
' e.g. 2020-06-11T00:00:00 if you only care about the date.
Const CPPUri As String = "http://schemas.microsoft.com/office/2006/coverPageProps"
Dim cxn As Office.CustomXMLNode
Dim cxps As Office.CustomXMLParts
Dim nsprefix As String
Set cxps = theDoc.CustomXMLParts.SelectByNamespace(CPPUri)
If cxps.Count > 0 Then
With cxps(1)
nsprefix = .NamespaceManager.LookupPrefix(CPPUri)
Set cxn = .SelectSingleNode(nsprefix & ":CoverPageProperties[1]/" & nsprefix & ":PublishDate[1]") '/PublishDate[1]")
If Not (cxn Is Nothing) Then
cxn.Text = theDate
Set cxn = Nothing
End If
End With
End If
Set cxps = Nothing
As for this, "Will word.application.documents accept the document name as a string", the answer is "yes", but Word has to have opened the document already. as mentioned above. Word can also accept an integer index into the .Documents collection and may accept just the name part of the FullName string.
Finally, if you do end up using a "traditional Custom Document Property", even after you have set the property and saved the document (approximately as above) you may find that the new property value has not actually saved! If so, that's down to an old error in Word where it won't save unless you have actually visited the Custom Document Property Dialog or have modified the document content in some way, e.g. adding a space at the end.

Is there a resolution in VBA for the error Run-time error '429' when trying to connect to a website?

I am trying to create a VBA to download a google sheet into excel so I can compile stock market data daily. I would simply use power query for this but I am doing this on my personal laptop which is a mac and does not support power query. I am relatively new to coding so have been leaning on following online instructions. The instruction includes this:
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
This line when ran creates an error message saying:
"
Run-time error '429':
ActiveX component can't create object
"
I think the issue lies within the fact that the instruction is based on a windows operating system. Any solution I've searched for is specific to windows operating systems.
Does anybody here know if I can change the "MSXML2.XMLHTTP.3.0" part of my code to fit it better to mac? Not sure if this is what needs to be done but any guidance would be super appreciated.
I attached my full code below but feel free to ignore it if not relavent. Thank you!!
Sub DownloadGoogleSheets()
Dim ShtUrl As String, Location As String, FileName As String
Dim objWebCon, objWrit As Object
'Sheet Url
ShtUrl = "https://docs.google.com/spreadsheets/d/1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0/export?format=csv&id=1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0" & gid = 1319327791
'Location
Location = ThisWorkbook.Path & "\" '/Users/[myName]/Desktop/Stock Analysis/n"
'FileName
FileName = "GoogleSheet.csv"
'Connection to Website
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
'Writer
Set objWrit = CreateObject("ADODB.Stream")
'Connecting to the Website
objWebCon.Open "Get", ShtUrl, False
objWebCon.Send (ShtUrl)
'Once page is fully loaded
If objWebCon.Status = 200 Then
'Write the text of the sheet
objWrit.Open
objWrit.Type = 1
objWrit.Write objWebCon.ResponseBody
objWrit.Position = 0
objWrit.SaveToFile Location & FileName
objWrit.Close
End If
Set objWebCon = Nothing
Set objWrit = Nothing
End Sub

How to retrieve specific information from XML type document

I`m working on a VBA macro in Excel, to gather information from a CNC program code.
So far, I have gotten Material type, thickness, x & Y sizes, and qty used.
I`m trying to get the 'cutting length' now - so I can use it in costing calculations.
Here is the XML code segment :
<Info num="6" name="Tools">
<MC machine="psys_ETN_5">
<Tool name="TN901" length="16262.96209" time="53.72817301" cutoutArea="8138.657052"/>
</MC>
</Info>
There are lots of 'Info' lines.
There may be more than one 'Tool' line, but I`m only after anything from line with 'TN901'.
The data I`m trying to capture is the value of 'Length="######.##"'
I`ve captured everything else I need from code like this :
<Material>316</Material>
<SheetX>2000</SheetX>
<SheetY>1000</SheetY>
<Thickness>3</Thickness>
</Material>
using code like this:
For Each nodemat In XMLDataDrg.SelectNodes("//Material")
Matl = nodemat.Text
Worksheets("Sheet4").Range("H" & RowA).Value = Matl
Next
For Each nodesht In XMLDataDrg.SelectNodes("//Thickness")
Thk = nodesht.Text
Worksheets("Sheet4").Range("I" & RowA).Value = Thk
Next
But that type of code does not get the cutting length.
Any help please ? :)
Thanks
Simon
Thickness is saved as XML element in your example.
The length is stored as an XML attribute.
(see https://www.xmlfiles.com/xml/xml-attributes/)
To read an XML attribute please have a look at:
Read XML Attribute VBA
Based on the code presented there you should be able to solve your issue with:
'Include a reference to Microsoft XML v3
Dim XMLDataDrg As DOMDocument30
Set XMLDataDrg = New DOMDocument30
XMLDataDrg.Load ("C:\...\sample.xml")
'...
Dim id As String
id = XMLDataDrg.SelectSingleNode("//Info/MC/Tool").Attributes.getNamedItem("length").Text
You can use an xpath to restrict to Tool elements with attribute name having value TN901 then loop all the attributes and write out. I am reading your XML from a file on desktop.
Option Explicit
Public Sub test()
Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.validateOnParse = True
.setProperty "SelectionLanguage", "XPath"
.async = False
If Not .Load("C:\Users\User\Desktop\Test.xml") Then
Err.Raise .parseError.ErrorCode, , .parseError.reason
End If
End With
Dim elem As Object, attrib As Object
For Each elem In xmlDoc.SelectNodes("//Tool[#name='TN901']")
For Each attrib In elem.Attributes
Debug.Print attrib.nodeName, attrib.Text
Next
Next
End Sub
Result:

After a WMI search in VBScript, can I create my search filter BEFORE my "For Each" statement?

I've created an alternative search utility to the Windows search utility with VBScript using a WQL search, but, as it turns out, it's quite slow. I would like to speed it up and I think I can do it, but I would need to place my search filter AFTER my WQL search and BEFORE my For Each statement. Is this even possible?
I've already tested by filtering in the WQL search, but it's about 40% faster if I filter after the WQL search. I've also tested with and without iFlags, but they tend to slow the search quite a bit, even though MS seems to believe otherwise.
Since the user can search by filename, creation date, last modified date and/or file size, if the filter is after the For Each statement then the script has to create the search filter each time it enumerates a file. I'd like to create the filter once in the hope of shaving some time off the search.
This will probably make better sense when you take a look at the snippet of code I've posted. Note that the sub subCreateSearchString will have calls to other search options and functions (ie: convert from UTC to local time, format file sizes, etc.)
Dim strSearchName, strComputer, objSWbemServices, objFile, colFiles
Dim strFileName, strReturnedFileName, strQueryDriveAndPath
strSearchName = "test" 'Text being searched for - change as needed
strQueryDriveAndPath = "PATH = '\\Drop_RW\\' AND DRIVE = 'D:'" 'Path and drive in which to search - change as needed
strComputer = "."
Set objSWbemServices = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objSWbemServices.ExecQuery("Select * from CIM_DataFile WHERE " & "" & strQueryDriveAndPath & "")
'* I'd like to place the call to "subCreateSearchString" here
On Error Resume Next
For Each objFile in colFiles
strReturnedFileName = objFile.Name
subCreateSearchString ' Search filter - it works when placed here
If strSearchForString Then
MsgBox "File matches:" & vbCrLf & strReturnedFileName
Else
MsgBox "File DOES NOT match" & vbCrLf & strReturnedFileName
End If
Next
Sub subCreateSearchString
'* Set Filename Variable for search:
strFileName = InStr(LCase(strReturnedFileName), LCase(strSearchName))
strSearchForString = strFileName
End Sub
Since you depend on the names of the files you're iterating over in the For Each loop: no, not possible.
I'd strongly recommend making some adjustments, though.
Use a Function rather than a Sub if you want to return something from a subroutine.
Avoid using global variables. They have a nasty tendency of introducing undesired side effects and also make debugging your code a pain in the rear. Pass values into your subroutines via parameters, and return values as actual return values.
The returned value is an integer (or Null), but you use it like a boolean and named your variables (and sub) as if it were a string. Don't do that. Name your functions/procedures after what they're doing, and name your variables after what they contain. And if you want to use a boolean value make your function actually return a boolean value.
Avoid Hungarian Notation. It's pointless code-bloat the way most people use it. Even more if your naming doesn't even match the actual type.
Do not use global On Error Resume Next. Ever. It simply makes your code fail silently without telling you anything about what actually went wrong. Keep error handling as local as possible. Enable it only for single commands or short code blocks, and only if there is no other way to avoid/handle the error.
Function IsInFilename(searchName, fileName)
IsInFilename = InStr(LCase(fileName), LCase(searchName)) > 0
End Function
For Each objFile in colFiles
If IsInFilename(strSearchName, objFile.Name) Then
MsgBox "..."
Else
MsgBox "..."
End If
Next

Resources